// 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
__