steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.extras: adding monotonic-count and max-monotonic-count.

db4
John Benediktsson 2013-05-01 21:56:34 -07:00
parent 2e94cb312a
commit 05ea081cd0
2 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/math/extras/extras-tests.factor
View File

@ -129,3 +129,6 @@ IN: math.extras.test
{ 5 } [ 3 5 round-to-step ] unit-test
{ 10 } [ 12 5 round-to-step ] unit-test
{ 15 } [ 13 5 round-to-step ] unit-test
{ { 0 1 2 3 0 0 1 } } [ { 1 2 3 3 2 1 2 } [ <= ] monotonic-count ] unit-test
{ 4 } [ { 1 2 3 1 2 3 4 5 } [ < ] max-monotonic-count ] unit-test

14
extra/math/extras/extras.factor
View File

@ -264,3 +264,17 @@ M: float round-to-even
: round-to-step ( x step -- y )
[ [ / round ] [ * ] bi ] unless-zero ;
: monotonic-count ( seq quot: ( elt1 elt2 -- ? ) -- newseq )
over empty? [ 2drop { } ] [
[ 0 swap unclip-slice swap ] dip '[
[ @ [ 1 + ] [ drop 0 ] if ] keep over
] { } map-as 2nip 0 prefix
] if ; inline
: max-monotonic-count ( seq quot: ( elt1 elt2 -- ? ) -- n )
over empty? [ 2drop 0 ] [
[ 0 swap unclip-slice swap 0 ] dip '[
[ swapd @ [ 1 + ] [ max 0 ] if ] keep swap
] reduce nip max
] if ; inline