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

add product-map-as and use it in poker vocab

db4
Doug Coleman 2009-11-25 23:18:18 -06:00
parent 7a00f24d6b
commit cdc1f1e041
3 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -44,6 +44,10 @@ HELP: product-map
{ $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." } { $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." }
{ $notes { $snippet "[ ... ] product-map" } " is equivalent to, but more efficient than, " { $snippet "<product-sequence> [ ... ] map" } "." } ; { $notes { $snippet "[ ... ] product-map" } " is equivalent to, but more efficient than, " { $snippet "<product-sequence> [ ... ] map" } "." } ;
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-each HELP: product-each
{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- )" } } } { $values { "sequences" sequence } { "quot" { $quotation "( sequence -- )" } } }
{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } "." } { $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } "." }
@ -57,6 +61,7 @@ ARTICLE: "sequences.product" "Product sequences"
product-sequence product-sequence
<product-sequence> <product-sequence>
product-map product-map
product-map-as
product-each product-each
} ; } ;

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

@ -55,11 +55,13 @@ M: product-sequence nth
[ ns sequences nths quot call ns lengths product-iter ] until [ ns sequences nths quot call ns lengths product-iter ] until
] unless ; inline ] unless ; inline
:: product-map ( sequences quot -- sequence ) :: product-map-as ( sequences quot exemplar -- sequence )
0 :> i! 0 :> i!
sequences [ length ] [ * ] map-reduce sequences sequences [ length ] [ * ] map-reduce exemplar
[| result | [| result |
sequences [ quot call i result set-nth i 1 + i! ] product-each sequences [ quot call i result set-nth i 1 + i! ] product-each
result result
] new-like ; inline ] new-like ; inline
: product-map ( sequences quot -- sequence )
over product-map-as ; inline

3
extra/poker/poker.factor
View File

@ -202,8 +202,9 @@ TUPLE: deck
{ cards sequence } ; { cards sequence } ;
: <deck> ( -- deck ) : <deck> ( -- deck )
RANK_STR SUIT_STR 2array [ concat >ckf ] product-map deck boa ; RANK_STR SUIT_STR 2array [ concat >ckf ] V{ } product-map-as deck boa ;
: shuffle ( deck -- deck ) : shuffle ( deck -- deck )
[ randomize ] change-cards ; [ randomize ] change-cards ;
: draw-card ( deck -- card ) cards>> pop ;