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 } } }
}"""
}
} ;
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 } }"
}
} ;
"Splitting into sequences:"
{ $subsections monotonic-split }
"Splitting into slices:"
-{ $subsections monotonic-slice }
+{ $subsections monotonic-split-slice }
"Trending:"
{ $subsections
downward-slices
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
{ { { 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
! 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
-PRIVATE>
-
-: monotonic-split ( seq quot: ( obj1 obj2 -- ? ) -- newseq )
- over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
-
-<PRIVATE
+ 0 0 seq [ ] [
+ [ 1 + ] 2dip [
+ quot call [
+ [ seq slice-quot call accum push ] keep dup
+ ] unless
+ ] keep
+ ] map-reduce drop
-:: (monotonic-slice) ( seq quot: ( obj1 obj2 -- ? ) slice-class -- slices )
- seq length :> len
- [
- 0 ,
+ n = [ drop ] [ n seq slice-quot call accum push ] if
- 0 seq [ ] [
- [ 1 + ] 2dip
- [ quot call [ dup , ] unless ] keep
- ] map-reduce 2drop
+ accum { } like ; inline
- len building get ?last = [ len , ] unless
-
- ] { } make dup rest-slice [ seq slice-class boa ] 2map ; inline
+: (monotonic-split) ( seq quot slice-quot -- pieces )
+ pick length [ 3drop { } ] [ ((monotonic-split)) ] if-zero ; 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 ( seq quot: ( obj1 obj2 -- ? ) -- pieces )
+ [ subseq-unsafe ] (monotonic-split) ; 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 > [
] 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?>>