]> gitweb.factorcode.org Git - factor.git/commitdiff
sequences.generalizations: adding nmap-reduce.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 27 Sep 2012 03:48:50 +0000 (20:48 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 27 Sep 2012 03:49:42 +0000 (20:49 -0700)
basis/sequences/generalizations/generalizations-docs.factor
basis/sequences/generalizations/generalizations-tests.factor
basis/sequences/generalizations/generalizations.factor

index acc9705f10f7fe2720b7b2c25ffd9531ac95afda..fbee36655e7a36752dfec85dab6395245c1ead01 100644 (file)
@@ -110,6 +110,10 @@ HELP: nproduce-as
 { $values { "pred" { $quotation "( -- ? )" } } { "quot" { $quotation "( -- obj1 obj2 ... objn )" } } { "exemplar..." { $snippet "n" } " sequences on the datastack" } { "n" integer } { "seq..." { $snippet "n" } " sequences on the datastack of the same types as the " { $snippet "exemplar" } "s" } }
 { $description "A generalization of " { $link produce-as } " that generates " { $snippet "n" } " sequences in parallel by calling " { $snippet "quot" } " repeatedly until " { $snippet "pred" } " outputs false." } ;
 
+HELP: nmap-reduce
+{ $values { "map-quot" quotation } { "reduce-quot" quotation } { "n" integer } }
+{ $description "A generalization of " { $link map-reduce } " that can be applied to any number of sequences." } ;
+
 ARTICLE: "sequences.generalizations" "Generalized sequence words"
 "The " { $vocab-link "sequences.generalizations" } " vocabulary defines generalized versions of various sequence operations."
 { $subsections
index ff2b7059300b510879be54c6996de5a719f91755..d3655786caf972307e043989cf8f1c4fbcc66179 100644 (file)
@@ -132,3 +132,7 @@ D4d$
 
 [ { 10 8 6 4 2 } { 9 7 5 3 1 } ]
 [ 10 nproduce-test ] unit-test
+
+{ 45 } [
+    { 1 2 3 } { 4 5 6 } { 7 8 9 } [ + + ] [ + ] 3 nmap-reduce
+] unit-test
index e50daf549d0814edee3a3289331480e3920e8f10..8fdb4eec38f18cf0147621a0f62823dabb392715 100644 (file)
@@ -42,6 +42,9 @@ MACRO: nmin-length ( n -- )
     dup 1 - [ min ] n*quot
     '[ [ length ] _ napply @ ] ;
 
+: nnth ( n seq... n -- )
+    [ nth ] swap [ apply-curry ] [ cleave* ] bi ; inline
+
 : nnth-unsafe ( n seq... n -- )
     [ nth-unsafe ] swap [ apply-curry ] [ cleave* ] bi ; inline
 
@@ -112,3 +115,9 @@ MACRO: (ncollect) ( n -- )
 
 : nproduce ( pred quot n -- seq... )
     [ { } swap dupn ] keep nproduce-as ; inline
+
+MACRO: nmap-reduce ( map-quot reduce-quot n -- quot )
+    -rot dupd compose [ over ] dip over '[
+        [ [ first ] _ napply @ 1 ] _ nkeep
+        _ _ (neach) (each-integer)
+    ] ;