splitting.monotonic: cleanup and simplify monotonic-split.

basis/splitting/monotonic/monotonic-docs.factor

@@ -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 }
+     { "seq" sequence } { "quot" { $quotation ( obj1 obj2 -- ? ) } }
-     { "slices" "a sequence of slices" }
+     { "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{ slice { to 3 } { seq { 1 2 3 2 3 4 } } }
-    T{ upward-slice
+    T{ slice { from 3 } { to 6 } { seq { 1 2 3 2 3 4 } } }
-        { 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

basis/splitting/monotonic/monotonic-tests.factor

@@ -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
+{ { { 1 } } } [ { 1 } [ < ] monotonic-split ] unit-test
-{ { V{ 1 2 } } } [ { 1 2 } [ < ] monotonic-split ] unit-test
+{ { { 1 2 } } } [ { 1 2 } [ < ] monotonic-split ] unit-test
-{ { V{ 1 } V{ 2 } } } [ { 1 2 } [ > ] monotonic-split ] unit-test
+{ { { 1 } { 2 } } } [ { 1 2 } [ > ] monotonic-split ] unit-test
-{ { V{ 1 } V{ -1 5 } V{ 2 4 } } }
+{ { { 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
+    [ [ odd? ] same? ] monotonic-split
-    [ >array ] map
 ] 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
+    [ [ odd? ] same? ] monotonic-split
-    [ >array ] map
 ] unit-test

basis/splitting/monotonic/monotonic.factor

@@ -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
+USING: accessors arrays fry kernel locals math namespaces
-sequences sorting ;
+sequences sequences.private sorting ;
 IN: splitting.monotonic
 
 <PRIVATE
 
-: (monotonic-split) ( seq quot -- newseq )
+:: ((monotonic-split)) ( seq quot slice-quot n -- pieces )
-    [ V{ } clone V{ } clone ] 2dip [ ] swap '[
+    V{ } clone :> accum
-        [ [ suffix! ] keep ] dip
+
-        [ @ [ suffix! V{ } clone ] unless ] keep
+    0 0 seq [ ] [
-    ] map-reduce suffix! suffix! { } like ; inline
+        [ 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 )
+: monotonic-split ( seq quot: ( obj1 obj2 -- ? ) -- pieces )
-    over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
+    [ subseq-unsafe ] (monotonic-split) ; inline
 
-<PRIVATE
+: monotonic-split-slice ( seq quot: ( obj1 obj2 -- ? ) -- pieces )
-
+    [ <slice-unsafe> ] (monotonic-split) ; inline
-:: (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
 
 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 > [

basis/wrap/words/words.factor

@@ -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?>>