]> gitweb.factorcode.org Git - factor.git/commitdiff
rename math.statistics:cum-map to sequences:accumulate*
authorJon Harper <jon.harper87@gmail.com>
Tue, 8 Mar 2016 14:04:35 +0000 (15:04 +0100)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 8 Mar 2016 21:41:54 +0000 (13:41 -0800)
basis/cpu/x86/sse/sse.factor
basis/math/statistics/statistics-docs.factor
basis/math/statistics/statistics.factor
core/sequences/sequences-docs.factor
core/sequences/sequences-tests.factor
core/sequences/sequences.factor
extra/benchmark/fasta/fasta.factor
extra/benchmark/hashtables/hashtables.factor
extra/images/tiff/tiff.factor
extra/imap/imap-tests.factor

index 4379bfa6f6c99cdf2a3448d6dfed5a690d6676f3..e8c67ad8c898f8d0abc1287d0c965ab2471f8480 100644 (file)
@@ -57,7 +57,7 @@ M: vector-rep copy-register* drop MOVDQA ;
 MACRO: available-reps ( alist -- quot )
     ! Each SSE version adds new representations and supports
     ! all old ones
-    unzip { } [ append ] accumulate rest swap suffix
+    unzip { } [ append ] accumulate*
     [ [ 1quotation ] map ] bi@ zip
     reverse [ { } ] suffix
     '[ _ cond ] ;
index 5c3ed0653b0dc114f9bef8879fe1b647a7086e47..8ed42560a7f41f7b956db3b23fe68286ca1c67f2 100644 (file)
@@ -302,10 +302,8 @@ ARTICLE: "histogram" "Computing histograms"
 } ;
 
 ARTICLE: "cumulative" "Computing cumulative sequences"
-"Cumulative mapping combinators:"
-{ $subsections
-    cum-map
-}
+"Cumulative words build on " { $link accumulate } " and " { $link accumulate* } "."
+$nl
 "Cumulative math:"
 { $subsections
     cum-sum
index fc25c01a06825b6959cc5acfef330ebeb763aecd..080c7acc7eea41db3d98867a8a6902cbaa277d66 100644 (file)
@@ -340,29 +340,26 @@ ALIAS: std sample-std
 
 : sample-corr ( x-seq y-seq -- corr ) 1 corr-ddof ; inline
 
-: cum-map ( seq identity quot: ( prev elt -- next ) -- seq' )
-    swapd [ dup ] compose map nip ; inline
-
 : cum-sum ( seq -- seq' )
-    0 [ + ] cum-map ;
+    0 [ + ] accumulate* ;
 
 : cum-sum0 ( seq -- seq' )
     0 [ + ] accumulate nip ;
 
 : cum-product ( seq -- seq' )
-    1 [ * ] cum-map ;
+    1 [ * ] accumulate* ;
 
 : cum-mean ( seq -- seq' )
     0 swap [ [ + dup ] dip 1 + / ] map-index nip ;
 
 : cum-count ( seq quot -- seq' )
-    [ 0 ] dip '[ _ call [ 1 + ] when ] cum-map ; inline
+    [ 0 ] dip '[ _ call [ 1 + ] when ] accumulate* ; inline
 
 : cum-min ( seq -- seq' )
-    dup ?first [ min ] cum-map ;
+    dup ?first [ min ] accumulate* ;
 
 : cum-max ( seq -- seq' )
-    dup ?first [ max ] cum-map ;
+    dup ?first [ max ] accumulate* ;
 
 : entropy ( probabilities -- n )
     dup sum '[ _ / dup log * ] map-sum neg ;
index 3e9b159eb66e6c15d29e6a0d0a20510127f9854b..7b0a205e3ef489a79e5c2f5b78b7caad07448407 100644 (file)
@@ -317,32 +317,68 @@ HELP: accumulate-as
 { $values { "seq" sequence } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "exemplar" sequence } { "final" "the final result" } { "newseq" "a new sequence" } }
 { $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of the same type as " { $snippet "exemplar" } " containing intermediate results, together with the final result."
 $nl
-"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
+"The first element of the output sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } " and the first element of the input sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the next element of the input sequence."
 $nl
-"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." } ;
+"When given the empty sequence, outputs a new empty sequence together with the " { $snippet "identity" } "." } ;
 
 HELP: accumulate
-{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "final" "the final result" } { "newseq" "a new array" } }
+{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "final" "the final result" } { "newseq" "a new sequence" } }
 { $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of intermediate results, together with the final result."
 $nl
-"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
+"The first element of the output sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } " and the first element of the input sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the next element of the input sequence."
 $nl
-"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." }
+"When given the empty sequence, outputs a new empty sequence together with the " { $snippet "identity" } "." }
 { $examples
     { $example "USING: math prettyprint sequences ;" "{ 2 2 2 2 2 } 0 [ + ] accumulate . ." "{ 0 2 4 6 8 }\n10" }
 } ;
 
 HELP: accumulate!
-{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "final" "the final result" } }
+{ $values { "seq" "a mutable sequence" } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "final" "the final result" } }
 { $description "Combines successive elements of the sequence using a binary operation, and outputs the original sequence of intermediate results, together with the final result."
 $nl
 "The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
 $nl
-"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." }
+"When given the empty sequence, outputs the same empty sequence together with the " { $snippet "identity" } "." }
+{ $errors "Throws an error if the sequence is immutable, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
+{ $side-effects "seq" }
 { $examples
     { $example "USING: math prettyprint sequences ;" "{ 2 2 2 2 2 } 0 [ + ] accumulate! . ." "{ 0 2 4 6 8 }\n10" }
 } ;
 
+HELP: accumulate*-as
+{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "exemplar" sequence } { "newseq" "a new sequence" } }
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of the same type as " { $snippet "exemplar" } " containing all results."
+$nl
+"On the first iteration, the two inputs to the quotation are " { $snippet "identity" } " and the first element of the input sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the next element of the input sequence."
+$nl
+"When given the empty sequence, outputs a new empty sequence" } ;
+
+HELP: accumulate*
+{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } { "newseq" sequence } }
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of all results."
+$nl
+"On the first iteration, the two inputs to the quotation are " { $snippet "identity" } " and the first element of the input sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the next element of the input sequence."
+$nl
+"When given the empty sequence, outputs a new empty sequence." }
+{ $examples
+    { $example "USING: math prettyprint sequences ;" "{ 2 2 2 2 2 } 0 [ + ] accumulate* ." "{ 2 4 6 8 10 }" }
+} ;
+
+HELP: accumulate*!
+{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation ( ... prev elt -- ... next ) } } }
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs the original sequence of all results."
+$nl
+"On the first iteration, the two inputs to the quotation are " { $snippet "identity" } " and the first element of the input sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the next element of the input sequence."
+$nl
+"When given the empty sequence, outputs the same empty sequence." }
+{ $errors "Throws an error if the sequence is immutable, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
+{ $side-effects "seq" }
+{ $examples
+    { $example "USING: math prettyprint sequences ;" "{ 2 2 2 2 2 } 0 [ + ] accumulate*! ." "{ 2 4 6 8 10 }" }
+} ;
+
+{ accumulate accumulate! accumulate-as accumulate* accumulate*! accumulate*-as } related-words
+
 HELP: map
 { $values { "seq" sequence } { "quot" { $quotation ( ... elt -- ... newelt ) } } { "newseq" "a new sequence" } }
 { $description "Applies the quotation to each element of the sequence in order. The new elements are collected into a sequence of the same class as the input sequence." } ;
@@ -1745,6 +1781,8 @@ ARTICLE: "sequences-combinators" "Sequence combinators"
     accumulate
     accumulate-as
     accumulate!
+    accumulate*
+    accumulate*-as
     produce
     produce-as
 }
@@ -1834,10 +1872,11 @@ ARTICLE: "sequences-destructive" "Destructive sequence operations"
     { { $link reverse } { $link reverse! } }
     { { $link append } { $link append! } }
     { { $link map } { $link map! } }
+    { { $link accumulate* } { $link accumulate*! } }
     { { $link filter } { $link filter! } }
 }
 "Changing elements:"
-{ $subsections map! change-nth }
+{ $subsections map! accumulate*! change-nth }
 "Deleting elements:"
 { $subsections
     remove!
index 486ea209193dfae0e3e00db3a8dbb907b1a1510f..baf2b8bbe17fed217d6fa47819c241fff25b39c6 100644 (file)
@@ -34,6 +34,18 @@ IN: sequences.tests
 { t }
 [ { 1 2 3 4 5 6 7 } dup 1 [ * ] accumulate! nip eq? ] unit-test
 
+{ { 1 2 6 24 120 720 5040 } }
+[ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate* ] unit-test
+
+{ B{ 2 4 16 64 } }
+[ B{ 2 2 4 4 } 1 [ * ] accumulate* ] unit-test
+
+{ { 1 2 6 24 120 720 5040 } }
+[ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate*! ] unit-test
+
+{ t }
+[ { 1 2 3 4 5 6 7 } dup 1 [ * ] accumulate*! eq? ] unit-test
+
 { f f } [ [ ] [ ] find ] unit-test
 { 0 1 } [ [ 1 ] [ ] find ] unit-test
 { 1 "world" } [ [ "hello" "world" ] [ "world" = ] find ] unit-test
index 4962ac926320e157d94921cffd4ef03e02c5f628..cc5cb5aecbe686bcf0e36e6ced66f70421e0ef01 100644 (file)
@@ -442,6 +442,9 @@ PRIVATE>
 : (accumulate) ( seq identity quot -- identity seq quot )
     swapd [ curry keep ] curry ; inline
 
+: (accumulate*) ( seq identity quot -- identity seq quot )
+    swapd [ dup ] compose ; inline
+
 PRIVATE>
 
 : each ( ... seq quot: ( ... x -- ... ) -- ... )
@@ -480,6 +483,15 @@ PRIVATE>
 : accumulate! ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... final seq )
     (accumulate) map! ; inline
 
+: accumulate*-as ( ... seq identity quot: ( ... prev elt -- ... next ) exemplar -- ... newseq )
+    [ (accumulate*) ] dip map-as nip ; inline
+
+: accumulate* ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... newseq )
+    pick accumulate*-as ; inline
+
+: accumulate*! ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... seq )
+    (accumulate*) map! nip ; inline
+
 : 2each ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ) -- ... )
     (2each) each-integer ; inline
 
index 36b93d18305fbb38f6bf9aec1b2760c74cc3cc22..ccf695bf726d512828fbdefdf7498e7d49349c48 100644 (file)
@@ -47,7 +47,7 @@ CONSTANT: homo-sapiens
 
 TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
     [ keys >byte-array ]
-    [ values c:double >c-array unclip [ + ] accumulate swap suffix ] bi ;
+    [ values c:double >c-array 0.0 [ + ] accumulate* ] bi ;
 
 :: select-random ( seed chars floats -- seed elt )
     seed next-fasta-random floats [ <= ] with find drop chars nth-unsafe ; inline
index f310c15be22a74de17b2165f6ccaf2cd0fb2cedc..d6738de9b6e458e8b2b20f9cc30b6b49868c684b 100644 (file)
@@ -7,7 +7,7 @@ QUALIFIED: assocs
 IN: benchmark.hashtables
 
 MEMO: strings ( -- str )
-    1 100 [a,b] 1 [ + ] accumulate nip [ number>string ] map ;
+    0 100 [a,b) 1 [ + ] accumulate* [ number>string ] map ;
 
 :: add-delete-mix ( hash keys -- )
     keys [| k |
index aee3d747d97c6d4e76779a69d8051dcf74860257..2fab7c147cd018307849e4867bf275caa707410e 100755 (executable)
@@ -473,7 +473,7 @@ ERROR: unhandled-compression compression ;
     [ * ] keep
     '[
         _ group
-        [ _ group unclip [ v+ ] accumulate swap suffix concat ] map
+        [ _ [ group ] [ 0 <array> ] bi [ v+ ] accumulate* concat ] map
         B{ } concat-as
     ] change-bitmap ;
 
index d79270cb56650d1ade2388ecd35ad465f6c4c31a..79536c61ea829933cb2e1b6af51cc6229aed08d1 100644 (file)
@@ -1,7 +1,7 @@
 USING: accessors arrays assocs calendar calendar.format
 combinators continuations destructors formatting fry grouping.extras imap
 imap.private io.streams.duplex kernel math math.parser math.ranges
-math.statistics namespaces random sequences sets sorting uuid
+namespaces random sequences sets sorting uuid
 splitting strings system tools.test memoize combinators.smart ;
 FROM: pcre => findall ;
 IN: imap.tests
@@ -157,7 +157,7 @@ MEMO: my-uuid ( -- str )
 ! A gmail compliant way of creating a folder hierarchy.
 [ ] [
     "foo/bar/baz/boo" test-folder "/" split
-    { } [ suffix ] cum-map [ "/" join ] map
+    { } [ suffix ] accumulate* [ "/" join ] map
     [ [ create-folder ] each ] [ [ delete-folder ] each ] bi
 ] imap-test