From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 12 Jul 2012 03:37:12 +0000 (-0700)
Subject: assocs.extras: adding a "zip-as" that is faster than "zip >hashtable".
X-Git-Tag: 0.97~2947
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=c3a6eab9ca94eb9d2f396b327015c7d43eb97857

assocs.extras: adding a "zip-as" that is faster than "zip >hashtable".
---

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index 0916a21728..e490beeaf1 100644
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -9,3 +9,7 @@ IN: assocs.extras
 { f } [ H{ { "a" H{ { "b" 1 } } } } { "a" "c" } deep-at ] unit-test
 { 1 } [ H{ { "a" H{ { "b" 1 } } } } { "a" "b" } deep-at ] unit-test
 { 4 } [ H{ { 1 H{ { 2 H{ { 3 4 } } } } } } { 1 2 3 } deep-at ] unit-test
+
+{  { { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 }  { } zip-as ] unit-test
+{ V{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
+{ H{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 18b8478042..d788ff6ce5 100644
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: assocs kernel sequences ;
+USING: arrays assocs assocs.private kernel sequences ;
 
 IN: assocs.extras
 
@@ -13,3 +13,11 @@ IN: assocs.extras
 
 : deep-at ( assoc seq -- value/f )
     [ swap at ] each ;
+
+: zip-as ( keys values exemplar -- assocs )
+    dup sequence? [
+        [ 2array ] swap 2map-as
+    ] [
+        [ dup length ] dip new-assoc
+        [ [ set-at ] with-assoc 2each ] keep
+    ] if ;