splitting.monotonic: cleanup and simplify monotonic-split.
John Benediktsson
parent
573ac9c9e9
commit
327a4ba5af
|
|
@ -3,23 +3,19 @@
|
|||
USING: help.markup help.syntax kernel quotations classes sequences ;
|
||||
IN: splitting.monotonic
|
||||
|
||||
HELP: monotonic-slice
|
||||
HELP: monotonic-split-slice
|
||||
{ $values
|
||||
{ "seq" sequence } { "quot" { $quotation ( obj1 obj2 -- ? ) } } { "slice-class" class }
|
||||
{ "slices" "a sequence of slices" }
|
||||
{ "seq" sequence } { "quot" { $quotation ( obj1 obj2 -- ? ) } }
|
||||
{ "pieces" "a sequence of slices" }
|
||||
}
|
||||
{ $description "Monotonically splits a sequence into slices of the type " { $snippet "slice-class" } "." }
|
||||
{ $description "Monotonically splits a sequence into slices." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: splitting.monotonic math prettyprint ;"
|
||||
"{ 1 2 3 2 3 4 } [ < ] upward-slice monotonic-slice ."
|
||||
"{ 1 2 3 2 3 4 } [ < ] monotonic-split-slice ."
|
||||
"""{
|
||||
T{ upward-slice { to 3 } { seq { 1 2 3 2 3 4 } } }
|
||||
T{ upward-slice
|
||||
{ from 3 }
|
||||
{ to 6 }
|
||||
{ seq { 1 2 3 2 3 4 } }
|
||||
}
|
||||
T{ slice { to 3 } { seq { 1 2 3 2 3 4 } } }
|
||||
T{ slice { from 3 } { to 6 } { seq { 1 2 3 2 3 4 } } }
|
||||
}"""
|
||||
}
|
||||
} ;
|
||||
|
|
@ -27,14 +23,14 @@ HELP: monotonic-slice
|
|||
HELP: monotonic-split
|
||||
{ $values
|
||||
{ "seq" sequence } { "quot" quotation }
|
||||
{ "newseq" "a sequence of sequences" }
|
||||
{ "pieces" "a sequence of sequences" }
|
||||
}
|
||||
{ $description "Compares pairs of elements in a sequence and collects elements into sequences while they satisfy the predicate. Once the predicate fails, a new sequence is started, and all sequences are returned in a single sequence." }
|
||||
{ $description "Monotonically splits a sequence." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: splitting.monotonic math prettyprint ;"
|
||||
"{ 1 2 3 2 3 4 } [ < ] monotonic-split ."
|
||||
"{ V{ 1 2 3 } V{ 2 3 4 } }"
|
||||
"{ { 1 2 3 } { 2 3 4 } }"
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
@ -90,7 +86,7 @@ ARTICLE: "splitting.monotonic" "Splitting trending sequences"
|
|||
"Splitting into sequences:"
|
||||
{ $subsections monotonic-split }
|
||||
"Splitting into slices:"
|
||||
{ $subsections monotonic-slice }
|
||||
{ $subsections monotonic-split-slice }
|
||||
"Trending:"
|
||||
{ $subsections
|
||||
downward-slices
|
||||
|
|
|
|||
|
|
@ -2,33 +2,33 @@ IN: splitting.monotonic
|
|||
USING: tools.test math arrays kernel sequences ;
|
||||
|
||||
{ { } } [ { } [ < ] monotonic-split ] 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 } [ < ] monotonic-split ] unit-test
|
||||
{ { { 1 2 } } } [ { 1 2 } [ < ] monotonic-split ] unit-test
|
||||
{ { { 1 } { 2 } } } [ { 1 2 } [ > ] monotonic-split ] unit-test
|
||||
{ { { 1 } { -1 5 } { 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 } } }
|
||||
[ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split ] unit-test
|
||||
|
||||
{ { } }
|
||||
[ "" [ = ] slice monotonic-slice ] unit-test
|
||||
[ "" [ = ] monotonic-split-slice ] unit-test
|
||||
|
||||
{ t }
|
||||
[ { 1 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test
|
||||
[ { 1 } [ = ] monotonic-split-slice [ slice? ] all? ] unit-test
|
||||
|
||||
{ { { 1 } } }
|
||||
[ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
|
||||
[ { 1 } [ = ] monotonic-split ] unit-test
|
||||
|
||||
[ { 1 } [ = ] slice monotonic-slice ] must-infer
|
||||
[ { 1 } [ = ] monotonic-split-slice ] must-infer
|
||||
|
||||
{ t }
|
||||
[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test
|
||||
[ { 1 1 1 2 2 3 3 4 } [ = ] monotonic-split-slice [ slice? ] all? ] unit-test
|
||||
|
||||
{ { { 1 1 1 } { 2 2 } { 3 3 } { 4 } } }
|
||||
[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
|
||||
[ { 1 1 1 2 2 3 3 4 } [ = ] monotonic-split ] unit-test
|
||||
|
||||
{ { { 3 3 } } }
|
||||
[ { 3 3 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
|
||||
[ { 3 3 } [ = ] monotonic-split ] unit-test
|
||||
|
||||
{ { } } [ "" trends ] unit-test
|
||||
|
||||
|
|
@ -64,14 +64,12 @@ USING: tools.test math arrays kernel sequences ;
|
|||
{ { { 2 2 } { 3 3 3 3 } { 4 } { 5 } } }
|
||||
[
|
||||
{ 2 2 3 3 3 3 4 5 }
|
||||
[ [ odd? ] same? ] slice monotonic-slice
|
||||
[ >array ] map
|
||||
[ [ odd? ] same? ] monotonic-split
|
||||
] unit-test
|
||||
|
||||
{
|
||||
{ { 1 1 1 } { 2 2 2 2 } { 3 3 } }
|
||||
} [
|
||||
{ 1 1 1 2 2 2 2 3 3 }
|
||||
[ [ odd? ] same? ] slice monotonic-slice
|
||||
[ >array ] map
|
||||
[ [ odd? ] same? ] monotonic-split
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -1,59 +1,52 @@
|
|||
! Copyright (C) 2008, 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays fry kernel locals make math namespaces
|
||||
sequences sorting ;
|
||||
USING: accessors arrays fry kernel locals math namespaces
|
||||
sequences sequences.private sorting ;
|
||||
IN: splitting.monotonic
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (monotonic-split) ( seq quot -- newseq )
|
||||
[ V{ } clone V{ } clone ] 2dip [ ] swap '[
|
||||
[ [ suffix! ] keep ] dip
|
||||
[ @ [ suffix! V{ } clone ] unless ] keep
|
||||
] map-reduce suffix! suffix! { } like ; inline
|
||||
:: ((monotonic-split)) ( seq quot slice-quot n -- pieces )
|
||||
V{ } clone :> accum
|
||||
|
||||
0 0 seq [ ] [
|
||||
[ 1 + ] 2dip [
|
||||
quot call [
|
||||
[ seq slice-quot call accum push ] keep dup
|
||||
] unless
|
||||
] keep
|
||||
] map-reduce drop
|
||||
|
||||
n = [ drop ] [ n seq slice-quot call accum push ] if
|
||||
|
||||
accum { } like ; inline
|
||||
|
||||
: (monotonic-split) ( seq quot slice-quot -- pieces )
|
||||
pick length [ 3drop { } ] [ ((monotonic-split)) ] if-zero ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: monotonic-split ( seq quot: ( obj1 obj2 -- ? ) -- newseq )
|
||||
over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
|
||||
: monotonic-split ( seq quot: ( obj1 obj2 -- ? ) -- pieces )
|
||||
[ subseq-unsafe ] (monotonic-split) ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
:: (monotonic-slice) ( seq quot: ( obj1 obj2 -- ? ) slice-class -- slices )
|
||||
seq length :> len
|
||||
[
|
||||
0 ,
|
||||
|
||||
0 seq [ ] [
|
||||
[ 1 + ] 2dip
|
||||
[ quot call [ dup , ] unless ] keep
|
||||
] map-reduce 2drop
|
||||
|
||||
len building get ?last = [ len , ] unless
|
||||
|
||||
] { } make dup rest-slice [ seq slice-class boa ] 2map ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: monotonic-slice ( seq quot: ( obj1 obj2 -- ? ) slice-class -- slices )
|
||||
pick length dup 1 > [
|
||||
drop (monotonic-slice)
|
||||
] [
|
||||
zero? [ 3drop { } ] [ nip [ 0 1 ] 2dip boa 1array ] if
|
||||
] if ; inline
|
||||
: monotonic-split-slice ( seq quot: ( obj1 obj2 -- ? ) -- pieces )
|
||||
[ <slice-unsafe> ] (monotonic-split) ; inline
|
||||
|
||||
TUPLE: downward-slice < slice ;
|
||||
TUPLE: stable-slice < slice ;
|
||||
TUPLE: upward-slice < slice ;
|
||||
|
||||
: downward-slices ( seq -- slices )
|
||||
[ > ] downward-slice monotonic-slice [ length 1 > ] filter ;
|
||||
[ > ] [ downward-slice boa ] (monotonic-split)
|
||||
[ length 1 > ] filter ;
|
||||
|
||||
: stable-slices ( seq -- slices )
|
||||
[ = ] stable-slice monotonic-slice [ length 1 > ] filter ;
|
||||
[ = ] [ stable-slice boa ] (monotonic-split)
|
||||
[ length 1 > ] filter ;
|
||||
|
||||
: upward-slices ( seq -- slices )
|
||||
[ < ] upward-slice monotonic-slice [ length 1 > ] filter ;
|
||||
[ < ] [ upward-slice boa ] (monotonic-split)
|
||||
[ length 1 > ] filter ;
|
||||
|
||||
: trends ( seq -- slices )
|
||||
dup length dup 1 > [
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ C: <word> word
|
|||
] if ;
|
||||
|
||||
: split-words ( seq -- half-elements )
|
||||
[ [ break?>> ] same? ] monotonic-split ;
|
||||
[ [ break?>> ] same? ] monotonic-split-slice ;
|
||||
|
||||
: ?first-break ( seq -- newseq f/element )
|
||||
dup first first break?>>
|
||||
|
|
|
|||
Loading…
Reference in New Issue