splitting.monotonic: faster and simpler monotonic-slice.

basis/splitting/monotonic/monotonic-docs.factor

@@ -5,20 +5,16 @@ IN: splitting.monotonic
 
 HELP: monotonic-slice
 { $values
-     { "seq" sequence } { "quot" quotation } { "class" class }
+     { "seq" sequence } { "quot" { $quotation ( obj1 obj2 -- ? ) } } { "slice-class" class }
      { "slices" "a sequence of slices" }
 }
-{ $description "Monotonically splits a sequence into slices of the type " { $snippet "class" } "." }
+{ $description "Monotonically splits a sequence into slices of the type " { $snippet "slice-class" } "." }
 { $examples
     { $example
         "USING: splitting.monotonic math prettyprint ;"
         "{ 1 2 3 2 3 4 } [ < ] upward-slice monotonic-slice ."
         """{
-    T{ upward-slice
-        { from 0 }
-        { to 3 }
-        { seq { 1 2 3 2 3 4 } }
-    }
+    T{ upward-slice { to 3 } { seq { 1 2 3 2 3 4 } } }
     T{ upward-slice
         { from 3 }
         { to 6 }
@@ -74,11 +70,7 @@ HELP: trends
         "USING: splitting.monotonic math prettyprint ;"
         "{ 1 2 3 3 2 1 } trends ."
         """{
-    T{ upward-slice
-        { from 0 }
-        { to 3 }
-        { seq { 1 2 3 3 2 1 } }
-    }
+    T{ upward-slice { to 3 } { seq { 1 2 3 3 2 1 } } }
     T{ stable-slice
         { from 2 }
         { to 4 }

basis/splitting/monotonic/monotonic-tests.factor

@@ -11,7 +11,7 @@ USING: tools.test math arrays kernel sequences ;
 [ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split ] unit-test
 
 { { } }
-[ { } [ = ] slice monotonic-slice ] unit-test
+[ "" [ = ] slice monotonic-slice ] unit-test
 
 { t }
 [ { 1 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test

basis/splitting/monotonic/monotonic.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2008, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays circular combinators
-combinators.short-circuit compiler.utilities fry grouping
-kernel make math math.order namespaces sequences sorting ;
+USING: accessors arrays fry kernel locals make math namespaces
+sequences sorting ;
 IN: splitting.monotonic
 
 <PRIVATE
@@ -20,28 +19,28 @@ PRIVATE>
 
 <PRIVATE
 
-: (monotonic-slice) ( seq quot class -- slices )
+:: (monotonic-slice) ( seq quot: ( obj1 obj2 -- ? ) slice-class -- slices )
+    seq length :> len
     [
-        dupd '[
-            [ length iota ] [ ] [ 1 circular boa ] tri
-            [ @ not [ 1 + , ] [ drop ] if ] 3each
-        ] { } make
-        2dup {
-            [ nip empty? ]
-            [ [ length ] [ last ] bi* = not ]
-        } 2|| [ over length suffix ] when
-        0 prefix 2 <clumps>
-        swap
-    ] dip
-    '[ first2 _ _ boa ] map ; inline
+        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 -- ? ) class -- slices )
-    pick length dup 1 >
-    [ drop (monotonic-slice) ]
-    [ zero? [ 2drop ] [ nip [ 0 1 ] 2dip boa 1array ] if ]
-    if ; inline
+: 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 ;