// nearest previous from arthur: >target application is a price series, > and here's my K version of Mr Boss's lpg1: > lpg1: {[y] > k:-1 + n:1 ; y:0i,y > b: (#y)#0 > while[ n<#y > yn:y[n] > while[ ~yn b[k:n]:k ; n+:1 > ] > -1+1 _ b } a little faster: f:{k:*b:&#a:0i,x;do[#x;c:a n:k+1;while[c>a k;k:b k];b[k:n]:k];b} a little shorter: g:{v:0i,x;(!1){:x,:(y>v@)x/-1+#x}/x} n:100 v:+\-.5+n _draw 0 \t do[1000;f v] / 260 \t do[1000;g v] / 310 the funny looking :x,: is to preserve refcount 1 (and constant time append for strong induction) from arthur: > problem, the term in f, > c>a k > should be > ~c neighbour's predecessor? And what size arrays - > ~10000 or ~100? 1000 to 1000000 > but if it's only a small array than who cares? yes. for less than 100 might as well do outer product, e.g. h:{x(*|&<)'(!#x)#\:x} > >f:{k:*b:&#a:0I,x;do[#x;c:a n:k+1;while[c>a k;k:b k];b[k:n]:k];b} this one below is 5 times as fast as the earlier one i posted^ g:{b:0|-1+i:!#x:0I,x;while[#i@:&x[i]>x b i;b[i]:b b i];b} v:+\m-1000 _draw 1+2*m:100 n:100 \t do[n;f v] 250 \t do[n;g v] 50 from arthur: > g:{b:0|-1+i:!#x:0I,x;while[#i@:&x[i]>x b i;b[i]:b b i];b} we don't need a sentinel(0I) in k4. (this looks for previous smaller value.) g:{b:-1+i:!#x;while[#i@:&x[i] \t do[n;g v] > 50 \t do[n;g v] 30 the functional equivalent isn't as fast: {{@[y;&xj:(-z)+i:&0>y;i@:k;j@:k (@[y;i k;:;j k:&b[x i;x j]];z)} g:{[b;x]*(f[b;x].)/(-1+&#x;1)} / nearest previous higher value (atw) g[<]a / nearest previous double g[{y=2*x}]a / each row of triangle h:{y{z-1+x[y z;|z#y]?1}[x]/:!#y} h[<]a / loop over rows of triangle i:{y{i:z;do[z;if[x[y z;y i-:1];:i]];-1}[x]/:!#y} i[<]a \ christian langreiter writes: assuming random numbers, this variant is excellent if we're dealing with high cardinality (high probability of quickly finding a larger predecessor). in case of low cardinality the following ("combing") is better; the two approaches complement each other quite nicely: lm:{n:#x;m:#u:?x;s:u@y}\:s {x[1;y]:(x 0)sd y;x[0;sm sd y]:y;x}/[(m#-1;n#0);!n]1} d: 20000 _draw 100 \t i[<]d 2052 \t lm d 50 (lm d)~i[<]d 1 mike day writes: But I'm still surprised that my beginner's K code is competitive, at least for "low cardinality." Here it is again... / reduce an arbitrary list to indices in sorted nub red: {{(?x[0 ; i / current < prev, so use previous index :[d<0 ; | / (1+ai1) _ saveix / current > prev, so find / greatest relevant preceding index r ] ] / current = prev, so use previous result saveix[ai:ai1] : i: i1 ] / reset index and prev value for next loop -1, 2 _ (a - 1) } / clean up result a10000_100: 10000 _draw 100 / nub size ~ cardinality ~ 100 \t do[10;atwl a10000_100] / my code 190 \t do[10;i[<] a10000_100] / stevan apter variants 4165 \t do[10;h[<] a10000_100] 2062 \t do[10;g[<] a10000_100] 8782 \t do[10;lm a10000_100] /chris langenreiter 220 and another mike day effort: Just in case the J & K lists aren't completely bored with this topic, here's another effort, which is much faster than my own previous ones, and also seems competitive with several other postings in J or K Once again it's loopy. I expect a repeat-to-convergence version could be worked up.... This one doesn't bother with saving nub values. It's rather like one of Stevan Apter's K methods, where you repeatedly examine the list, comparing elements in iteration k with their preceding k-neighbours. Significant savings appear to be achieved by (a) "removing" any increasing elements from the do-list from the start (b) pruning done elements from the do-list at each iteration / remove the leading "/"s (K comments) to run in J / / atwmd =: 3 : 0 NB. MDay's new atw / a =. y. / r =. _1 #~ #a / k =. 0 / ia =. I. (~:>./\) a NB. often worth removing latest maxima / NB. from do-list / while. (*#ia) *. k < #a do. / nia=. ia - k =. >: k / ai =. ia { a / ok =. ai < nia { a / ja =. ok # ia / r =. (ok#nia) ja } r / ia =. ia -. ja NB. remove done from do-list / ia =. ia #~ ia > k NB. remove low indices (to avoid wrap-sround) / end. / NB. k =: k NB. keep counter for debug/enjoyment / r / ) / NB. some tests / a100_100000 =: ?100000#100 NB. nub-size ~ 100 / NB. ts returns time & space / ts'atwmd a100_100000' NB. MDay / 0.102808 4.06598e6 / ts'lpg1 a100_100000' NB. RE Boss / 2.09188 2.42726e6 / a10000_10000 =: ?10000#10000 NB. nub-size ~ 10000 / ts'h2 a10000_10000' NB. Don Guinn / 0.387385 280000 / ts'atwmd a10000_10000' NB. MDay / 0.0649996 510656 / ts'atwmd i. 10000' NB. try extreme examples / 0.000135492 215616 / ts'atwmd -i. 10000' / 0.00196058 805440 NB. Here it is in K - remove leading NB. (J comments) in a K session NB. atwmd: { [a] NB. r : (#a)#-1 ; k:0 NB. ia: & ~{x= |\ x} a / often worth removing latest maxima NB. / from do-list NB. while[ (0<#ia) & k < #a NB. nia : ia - k: k+1 NB. ai : a @ ia NB. ok : ai < a @ nia NB. ja : ia @ & ok NB. r[ja]: nia @ & ok NB. ia : ia @ & ~ ok / remove done from do-list NB. ia : ia @ & ia > k / remove low indices (to avoid wrap-around) NB. ] NB. r} NB. / check performance of some K candidates... NB. b:10000_draw 10 NB. {(atwmd x)~i[<]x}b NB. 1 NB. \t do[10;atwl b] / my earlier looping vn, using saved nub results NB. 180 NB. \t do[10;lm b] / Chris Langreiter NB. 190 NB. \t do[10;g[<] b] / Stevan Apter NB. 13799 NB. \t do[10;h[<] b] / Stevan Apter NB. 2173 NB. \t do[10;i[<] b] / Stevan Apter NB. 40608 NB. \t do[10;sa1 b] / Stevan Apter NB. 140 NB. \t do[10;atwmd b] / MD new version NB. 20 NB. what about extreme examples? NB. \t do[10;atwmd (-!10000)] NB. 10 NB. \t do[10;atwmd (!10000)] NB. 0