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

splitting.monotonic: faster monotonic-split.

db4
John Benediktsson 2014-11-15 16:52:31 -08:00
parent ef6b2e231f
commit 305ba30e96
2 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/splitting/monotonic/monotonic-tests.factor
View File

@ -2,10 +2,13 @@ IN: splitting.monotonic
USING: tools.test math arrays kernel sequences ;
{ { } } [ { } [ < ] monotonic-split ] unit-test
[ { { 1 } { -1 5 } { 2 4 } } ]
[ { 1 -1 5 2 4 } [ < ] monotonic-split [ >array ] map ] unit-test
[ { { 1 1 1 1 } { 2 2 } { 3 } { 4 } { 5 } { 6 6 6 } } ]
[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split [ >array ] map ] unit-test
{ { V{ 1 } } } [ { 1 } [ < ] monotonic-split ] unit-test
{ { V{ 1 2 } } } [ { 1 2 } [ < ] monotonic-split ] unit-test
{ { V{ 1 } V{ 2 } } } [ { 1 2 } [ > ] monotonic-split ] unit-test
[ { V{ 1 } V{ -1 5 } V{ 2 4 } } ]
[ { 1 -1 5 2 4 } [ < ] monotonic-split ] unit-test
[ { V{ 1 1 1 1 } V{ 2 2 } V{ 3 } V{ 4 } V{ 5 } V{ 6 6 6 } } ]
[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split ] unit-test
[ { } ]
[ { } [ = ] slice monotonic-slice ] unit-test

12
basis/splitting/monotonic/monotonic.factor
View File

@ -7,15 +7,11 @@ IN: splitting.monotonic
<PRIVATE
: ,, ( obj -- ) building get last push ;
: v, ( -- ) V{ } clone , ;
: ,v ( -- ) building get dup last empty? [ dup pop* ] when drop ;
: (monotonic-split) ( seq quot -- newseq )
[
[ dup unclip suffix ] dip
v, '[ over ,, @ [ v, ] unless ] 2each ,v
] { } make ; inline
[ V{ } clone V{ } clone ] 2dip [ ] swap '[
[ [ over push ] keep ] dip
[ @ [ over push V{ } clone ] unless ] keep
] map-reduce over push over push { } like ; inline
PRIVATE>