math.statistics: Add cum-count, cum-sum0, cum-map0. Add docs.

basis/math/statistics/statistics-docs.factor

@@ -184,6 +184,17 @@ HELP: cum-sum
     }
 } ;
 
+HELP: cum-count
+{ $values { "seq" sequence } { "quot" quotation } { "seq'" sequence } }
+{ $description "Returns the cumulative count of how many times " { $snippet "quot" } " returns true." }
+{ $examples
+    { $example "USING: math math.statistics prettyprint ;"
+               "{ 1 -1 2 -1 4 } [ 0 < ] cum-count ."
+               "{ 0 1 1 2 2 }"
+    }
+} ;
+
+
 HELP: cum-product
 { $values { "seq" sequence } { "seq'" sequence } }
 { $description "Returns the cumulative product of " { $snippet "seq" } "." }
@@ -241,6 +252,22 @@ ARTICLE: "histogram" "Computing histograms"
     sequence>hashtable
 } ;
 
+ARTICLE: "cumulative" "Computing cumulative sequences"
+"Cumulative mapping combinators:"
+{ $subsections
+    cum-map
+    cum-map0
+}
+"Cumulative sum:"
+{ $subsections
+    cum-sum
+    cum-sum0
+}
+"Cumulative count:"
+{ $subsections
+    cum-count
+} ;
+
 ARTICLE: "math.statistics" "Statistics"
 "Computing the mean:"
 { $subsections mean geometric-mean harmonic-mean }
@@ -255,7 +282,9 @@ ARTICLE: "math.statistics" "Statistics"
 "Computing the kth smallest element:"
 { $subsections kth-smallest }
 "Counting the frequency of occurrence of elements:"
-{ $subsection "histogram" } ;
+{ $subsection "histogram" }
+"Computing cumulative sequences:"
+{ $subsection "cumulative" } ;
 
 ABOUT: "math.statistics"
 

basis/math/statistics/statistics-tests.factor

@@ -191,3 +191,12 @@ IN: math.statistics.tests
     { 1 0 2 3 4 }
 }
 [ { 3 1 4 15 92 } rank-values ] unit-test
+
+{ { 1 1 2 3 3 4 } }
+[ { 1 2 3 3 2 3 } [ odd? ] cum-count ] unit-test
+
+{ { 0 0 1 2 2 3 } }
+[ { 1 2 3 3 2 3 } [ 3 = ] cum-count ] unit-test
+
+{ { 0 1 3 6 } }
+[ { 1 2 3 4 } cum-sum0 ] unit-test

basis/math/statistics/statistics.factor

@@ -333,12 +333,22 @@ ALIAS: corr sample-corr
 : cum-map ( seq identity quot -- seq' )
     swapd [ dup ] compose map nip ; inline
 
+: cum-map0 ( seq identity quot -- seq' )
+    accumulate nip ; inline
+
 : cum-sum ( seq -- seq' )
     0 [ + ] cum-map ;
 
+: cum-sum0 ( seq -- seq' )
+    0 [ + ] cum-map0 ;
+
 : cum-product ( seq -- seq' )
     1 [ * ] cum-map ;
 
+: cum-count ( seq quot -- seq' )
+    [ 0 ] dip
+    '[ _ call [ 1 + ] when ] cum-map ; inline
+
 : cum-min ( seq -- seq' )
     dup ?first [ min ] cum-map ;