From 4dd3511a402bc2ec6be31179ee5eb63d49a6148f Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 26 Sep 2012 20:48:50 -0700
Subject: [PATCH] sequences.generalizations: adding nmap-reduce.

---
 .../generalizations/generalizations-docs.factor          | 4 ++++
 .../generalizations/generalizations-tests.factor         | 4 ++++
 basis/sequences/generalizations/generalizations.factor   | 9 +++++++++
 3 files changed, 17 insertions(+)

diff --git a/basis/sequences/generalizations/generalizations-docs.factor b/basis/sequences/generalizations/generalizations-docs.factor
index acc9705f10..fbee36655e 100644
--- a/basis/sequences/generalizations/generalizations-docs.factor
+++ b/basis/sequences/generalizations/generalizations-docs.factor
@@ -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
diff --git a/basis/sequences/generalizations/generalizations-tests.factor b/basis/sequences/generalizations/generalizations-tests.factor
index ff2b705930..d3655786ca 100644
--- a/basis/sequences/generalizations/generalizations-tests.factor
+++ b/basis/sequences/generalizations/generalizations-tests.factor
@@ -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
diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor
index e50daf549d..8fdb4eec38 100644
--- a/basis/sequences/generalizations/generalizations.factor
+++ b/basis/sequences/generalizations/generalizations.factor
@@ -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)
+    ] ;