steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add product-map>assoc and docs

Doug Coleman 2009-11-27 22:58:17 -06:00
parent 9e6261ce7a
commit e161ea06ce
2 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/sequences/product/product-docs.factor
View File

@ -1,5 +1,5 @@
! (c)2009 Joe Groff bsd license
USING: help.markup help.syntax quotations sequences ;
USING: assocs help.markup help.syntax quotations sequences ;
IN: sequences.product
HELP: product-sequence
@ -48,6 +48,10 @@ HELP: product-map-as
{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- value )" } } { "exemplar" sequence } { "sequence" sequence } }
{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } " and collects the results from " { $snippet "quot" } " into an output sequence the same type as the " { $snippet "exemplar" } " sequence." } ;
HELP: product-map>assoc
{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- key value )" } } { "exemplar" assoc } { "assoc" assoc } }
{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } " and collects the results from " { $snippet "quot" } " into an output assoc." } ;
HELP: product-each
{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- )" } } }
{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } "." }
@ -62,6 +66,7 @@ ARTICLE: "sequences.product" "Product sequences"
<product-sequence>
product-map
product-map-as
product-map>assoc
product-each
} ;

10
basis/sequences/product/product.factor
View File

@ -1,5 +1,5 @@
! (c)2009 Joe Groff bsd license
USING: accessors arrays kernel locals math sequences ;
USING: accessors arrays assocs kernel locals math sequences ;
IN: sequences.product
TUPLE: product-sequence { sequences array read-only } { lengths array read-only } ;
@ -65,3 +65,11 @@ M: product-sequence nth
: product-map ( sequences quot -- sequence )
over product-map-as ; inline
:: product-map>assoc ( sequences quot exemplar -- assoc )
0 :> i!
sequences [ length ] [ * ] map-reduce { }
[| result |
sequences [ quot call 2array i result set-nth i 1 + i! ] product-each
result
] new-like exemplar assoc-like ; inline