From cb6ddb1735d364910bd56154eebc1df7c9e93a40 Mon Sep 17 00:00:00 2001 From: Jon Harper Date: Tue, 8 Mar 2016 15:04:35 +0100 Subject: [PATCH] rename math.statistics:cum-map to sequences:accumulate* --- basis/cpu/x86/sse/sse.factor | 2 +- basis/math/statistics/statistics-docs.factor | 6 +-- basis/math/statistics/statistics.factor | 13 ++--- core/sequences/sequences-docs.factor | 55 +++++++++++++++++--- core/sequences/sequences-tests.factor | 12 +++++ core/sequences/sequences.factor | 12 +++++ extra/benchmark/fasta/fasta.factor | 2 +- extra/benchmark/hashtables/hashtables.factor | 2 +- extra/images/tiff/tiff.factor | 2 +- extra/imap/imap-tests.factor | 4 +- 10 files changed, 84 insertions(+), 26 deletions(-) diff --git a/basis/cpu/x86/sse/sse.factor b/basis/cpu/x86/sse/sse.factor index 4379bfa6f6..e8c67ad8c8 100644 --- a/basis/cpu/x86/sse/sse.factor +++ b/basis/cpu/x86/sse/sse.factor @@ -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 ] ; diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index 5c3ed0653b..8ed42560a7 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -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 diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index fc25c01a06..080c7acc7e 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -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 ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 3e9b159eb6..7b0a205e3e 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -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! diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 486ea20919..baf2b8bbe1 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -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 diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 4962ac9263..cc5cb5aecb 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -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 diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 36b93d1830..ccf695bf72 100644 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -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 diff --git a/extra/benchmark/hashtables/hashtables.factor b/extra/benchmark/hashtables/hashtables.factor index f310c15be2..d6738de9b6 100644 --- a/extra/benchmark/hashtables/hashtables.factor +++ b/extra/benchmark/hashtables/hashtables.factor @@ -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 | diff --git a/extra/images/tiff/tiff.factor b/extra/images/tiff/tiff.factor index aee3d747d9..2fab7c147c 100755 --- a/extra/images/tiff/tiff.factor +++ b/extra/images/tiff/tiff.factor @@ -473,7 +473,7 @@ ERROR: unhandled-compression compression ; [ * ] keep '[ _ group - [ _ group unclip [ v+ ] accumulate swap suffix concat ] map + [ _ [ group ] [ 0 ] bi [ v+ ] accumulate* concat ] map B{ } concat-as ] change-bitmap ; diff --git a/extra/imap/imap-tests.factor b/extra/imap/imap-tests.factor index d79270cb56..79536c61ea 100644 --- a/extra/imap/imap-tests.factor +++ b/extra/imap/imap-tests.factor @@ -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 -- 2.34.1