add upward/stable/downward slices, monotonic-slice, trends and docs

basis/splitting/monotonic/monotonic-docs.factor

@@ -0,0 +1,109 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations classes sequences
+multiline ;
+IN: splitting.monotonic
+
+HELP: monotonic-slice
+{ $values
+     { "seq" sequence } { "quot" quotation } { "class" class }
+     { "slices" "a sequence of slices" }
+}
+{ $description "Monotonically splits a sequence into slices of the type " { $snippet "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
+        { from 3 }
+        { to 6 }
+        { seq { 1 2 3 2 3 4 } }
+    }
+}">
+    }
+} ;
+
+HELP: monotonic-split
+{ $values
+     { "seq" sequence } { "quot" quotation }
+     { "newseq" "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." }
+{ $examples
+    { $example
+        "USING: splitting.monotonic math prettyprint ;"
+        "{ 1 2 3 2 3 4 } [ < ] monotonic-split ."
+        "{ V{ 1 2 3 } V{ 2 3 4 } }"
+    }
+} ;
+
+HELP: downward-slices
+{ $values
+     { "seq" sequence }
+     { "slices" "a sequence of downward-slices" }
+}
+{ $description "Returns an array of monotonically decreasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ;
+
+HELP: stable-slices
+{ $values
+    { "seq" sequence }
+    { "slices" "a sequence of stable-slices" }
+}
+{ $description "Returns an array of monotonically decreasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ;
+
+HELP: upward-slices
+{ $values
+    { "seq" sequence }
+    { "slices" "a sequence of upward-slices" }
+}
+{ $description "Returns an array of monotonically increasing slices of type " { $link downward-slice } ". Slices of one element are discarded." } ;
+
+HELP: trends
+{ $values
+    { "seq" sequence }
+    { "slices" "a sequence of downward, stable, and upward slices" }
+}
+{ $description "Returns a sorted sequence of downward, stable, or upward slices. The endpoints of some slices may overlap with each other." }
+{ $examples
+    { $example
+        "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{ stable-slice
+        { from 2 }
+        { to 4 }
+        { seq { 1 2 3 3 2 1 } }
+    }
+    T{ downward-slice
+        { from 3 }
+        { to 6 }
+        { seq { 1 2 3 3 2 1 } }
+    }
+}">
+    }
+} ;
+
+ARTICLE: "splitting.monotonic" "Splitting trending sequences"
+"The " { $vocab-link "splitting.monotonic" } " vocabulary splits sequences that are trending downwards, upwards, or stably." $nl
+"Splitting into sequences:"
+{ $subsection monotonic-split }
+"Splitting into slices:"
+{ $subsection monotonic-slice }
+"Trending:"
+{ $subsection downward-slices }
+{ $subsection stable-slices }
+{ $subsection upward-slices }
+{ $subsection trends } ;
+
+ABOUT: "splitting.monotonic"

basis/splitting/monotonic/monotonic-tests.factor

@@ -6,3 +6,48 @@ USING: tools.test math arrays kernel sequences ;
 [ { { 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
 
+[ { } ]
+[ { } [ = ] slice monotonic-slice ] unit-test
+
+[ t ]
+[ { 1 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test
+
+[ { { 1 } } ]
+[ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
+
+[ t ]
+[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-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
+
+[ { { 3 3 } } ]
+[ { 3 3 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
+
+[
+    {
+        T{ upward-slice { from 0 } { to 3 } { seq { 1 2 3 2 1 } } }
+        T{ downward-slice { from 2 } { to 5 } { seq { 1 2 3 2 1 } } }
+    }
+]
+[ { 1 2 3 2 1 } trends ] unit-test
+
+[
+    {
+        T{ upward-slice
+            { from 0 }
+            { to 3 }
+            { seq { 1 2 3 3 2 1 } }
+        }
+        T{ stable-slice
+            { from 2 }
+            { to 4 }
+            { seq { 1 2 3 3 2 1 } }
+        }
+        T{ downward-slice
+            { from 3 }
+            { to 6 }
+            { seq { 1 2 3 3 2 1 } }
+        }
+    }
+] [ { 1 2 3 3 2 1 } trends ] unit-test

basis/splitting/monotonic/monotonic.factor

@@ -1,8 +1,11 @@
-! Copyright (C) 2008 Doug Coleman.
+! Copyright (C) 2008, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: make namespaces sequences kernel fry ;
+USING: make namespaces sequences kernel fry arrays compiler.utilities
+math accessors circular grouping combinators sorting math.order ;
 IN: splitting.monotonic
 
+<PRIVATE
+
 : ,, ( obj -- ) building get peek push ;
 : v, ( -- ) V{ } clone , ;
 : ,v ( -- ) building get dup peek empty? [ dup pop* ] when drop ;
@@ -13,5 +16,52 @@ IN: splitting.monotonic
         v, '[ over ,, @ [ v, ] unless ] 2each ,v
     ] { } make ; inline
 
+PRIVATE>
+
 : monotonic-split ( seq quot -- newseq )
     over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
+
+<PRIVATE
+
+: (monotonic-slice) ( seq quot class -- slices )
+    -rot
+    dupd '[
+        [ length ] [ ] [ <circular> 1 over change-circular-start ] tri
+        [ @ not [ , ] [ drop ] if ] 3each
+    ] { } make
+    dup empty? [ over length 1- prefix ] when -1 prefix 2 clump
+    [ first2 [ 1+ ] bi@ rot roll boa ] with with map ; inline
+
+PRIVATE>
+
+: monotonic-slice ( seq quot class -- slices )
+    pick length {
+        { 0 [ 2drop ] }
+        { 1 [ nip [ 0 1 rot ] dip boa 1array ] }
+        [ drop (monotonic-slice) ]
+    } case ;
+
+TUPLE: downward-slice < slice ;
+TUPLE: stable-slice < slice ;
+TUPLE: upward-slice < slice ;
+
+: downward-slices ( seq -- slices )
+    [ > ] downward-slice monotonic-slice [ length 1 > ] filter ;
+
+: stable-slices ( seq -- slices )
+    [ = ] stable-slice monotonic-slice [ length 1 > ] filter ;
+
+: upward-slices ( seq -- slices )
+    [ < ] upward-slice monotonic-slice [ length 1 > ] filter ;
+
+: trends ( seq -- slices )
+    dup length {
+        { 0 [ ] }
+        { 1 [ [ 0 1 ] dip stable-slice boa ] }
+        [
+            drop
+            [ downward-slices ]
+            [ stable-slices ]
+            [ upward-slices ] tri 3append [ [ from>> ] compare ] sort
+        ]
+    } case ;