From f497c7e1519dad6624ac912600c95a2a6f6e1f25 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 11:29:12 -0500
Subject: [PATCH] Move map-reduce combinator to core, re-implement norm-sq and
 v. for better performance

---
 basis/math/vectors/vectors-tests.factor |  4 ++++
 basis/math/vectors/vectors.factor       |  6 +++---
 core/sequences/sequences.factor         | 11 +++++++++++
 extra/sequences/lib/lib-tests.factor    |  3 ---
 extra/sequences/lib/lib.factor          |  3 ---
 5 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/basis/math/vectors/vectors-tests.factor b/basis/math/vectors/vectors-tests.factor
index 5c71e2374f..498bb81f62 100644
--- a/basis/math/vectors/vectors-tests.factor
+++ b/basis/math/vectors/vectors-tests.factor
@@ -5,3 +5,7 @@ USING: math.vectors tools.test ;
 [ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
 [ { 1 2 3 } ] [ { 2 4 6 } 2 v/n ] unit-test
 [ { 1/1 1/2 1/3 } ] [ 1 { 1 2 3 } n/v ] unit-test
+
+[ 4 ] [ { 1 2 } norm-sq ] unit-test
+[ 36 ] [ { 2 3 } norm-sq ] unit-test
+
diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index b6ac459123..5316720b2f 100755
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel sequences math math.functions hints
 math.order ;
@@ -19,8 +19,8 @@ IN: math.vectors
 : vmax ( u v -- w ) [ max ] 2map ;
 : vmin ( u v -- w ) [ min ] 2map ;
 
-: v. ( u v -- x ) 0 [ * + ] 2reduce ;
-: norm-sq ( v -- x ) 0 [ absq + ] reduce ;
+: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
+: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
 : norm ( v -- x ) norm-sq sqrt ;
 : normalize ( u -- v ) dup norm v/n ;
 
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 6f755e5cb5..ae895f4853 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -747,6 +747,17 @@ PRIVATE>
 : unclip-slice ( seq -- rest first )
     [ rest-slice ] [ first ] bi ; inline
 
+: map-reduce ( seq map-quot reduce-quot -- result )
+    [ [ unclip-slice ] dip [ call ] keep ] dip
+    compose reduce ; inline
+
+: 2map-reduce ( seq1 seq2 map-quot reduce-quot -- result )
+    [ [ 2unclip-slice ] dip [ call ] keep ] dip
+    compose 2reduce ; inline
+
+: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 )
+    [ unclip-slice ] bi@ swapd ; inline
+
 : unclip-last-slice ( seq -- butlast last )
     [ but-last-slice ] [ peek ] bi ; inline
 
diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor
index 12bdd45c46..18c9d7f735 100755
--- a/extra/sequences/lib/lib-tests.factor
+++ b/extra/sequences/lib/lib-tests.factor
@@ -10,9 +10,6 @@ IN: sequences.lib.tests
 { { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
 [ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
 
-[ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
-[ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
-
 [ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test
 [ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test
 
diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index ba49b8ee9e..0ce4f56f7a 100755
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -31,9 +31,6 @@ IN: sequences.lib
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: map-reduce ( seq map-quot reduce-quot -- result )
-    >r [ unclip ] dip [ call ] keep r> compose reduce ; inline
-
 : reduce* ( seq quot -- result ) [ ] swap map-reduce ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!