diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index f7001e43b1..843aa47207 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/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" diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor index dfc373f7e7..b4082813c5 100644 --- a/basis/math/statistics/statistics-tests.factor +++ b/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 diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index 59fabea818..0e69a3c364 100644 --- a/basis/math/statistics/statistics.factor +++ b/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 ;