grouping.extras: group-by is faster with vectors.

diff --git a/extra/grouping/extras/extras-tests.factor b/extra/grouping/extras/extras-tests.factor
index d696f5f4806a1ff33e830277fb9066700c392c87..6033921587d9ec5066da330c275c8acac99e101f 100644 (file)
--- a/extra/grouping/extras/extras-tests.factor
+++ b/extra/grouping/extras/extras-tests.factor
@@ -22,20 +22,17 @@ IN: grouping.extras
 { { B{ 97 115 } B{ 100 102 } } } [ "asdf" 2 B{ } group-as ] unit-test
 { { { 97 115 } { 115 100 } { 100 102 } } } [ "asdf" 2 { } clump-as ] unit-test
 
-[
-    {
-        { 0 { 0 1 2 } }
-        { 1 { 3 4 5 } }
-        { 2 { 6 7 8 } }
-        { 3 { 9 } } }
-] [
+{
+    V{
+        { 0 V{ 0 1 2 } }
+        { 1 V{ 3 4 5 } }
+        { 2 V{ 6 7 8 } }
+        { 3 V{ 9 } } }
+} [
     10 iota [ 3 / floor ] group-by
 ] unit-test
 
-[
-    { { t { 0 1 2 3 4 5 6 7 8 9 } } }
-] [ 10 iota [ drop t ] group-by ] unit-test
+{ V{ { t V{ 0 1 2 3 4 5 6 7 8 9 } } } }
+[ 10 iota [ drop t ] group-by ] unit-test
 
-[
-    { }
-] [ { } [ drop t ] group-by ] unit-test
+{ V{ } } [ { } [ drop t ] group-by ] unit-test

diff --git a/extra/grouping/extras/extras.factor b/extra/grouping/extras/extras.factor
index fdac237e59570337f74bac1d3510251aff2eb16c..971626d919869c4ebf00e8c04b9b3ad483e17407 100644 (file)
--- a/extra/grouping/extras/extras.factor
+++ b/extra/grouping/extras/extras.factor
@@ -1,6 +1,6 @@
 USING: accessors arrays combinators fry grouping kernel macros math
 math.ranges sequences sequences.generalizations
-sequences.private ;
+sequences.private vectors ;
 
 IN: grouping.extras
 
@@ -49,12 +49,16 @@ INSTANCE: tail-clumps immutable-sequence
 : group-as ( seq n exemplar -- array )
     [ <groups> ] dip [ like ] curry map ;
 
-: (group-by-loop) ( elt key groups -- groups' )
-    2dup [ nip empty? ] [ ?last ?first = not ] 2bi or [
-        -rot swap 1array
+<PRIVATE
+
+: (group-by) ( elt key groups -- groups' )
+    pick [ t ] [ last first dupd = not ] if-empty [
+        swap 1vector 2array over push
     ] [
-        nip unclip-last rot [ first2 ] dip suffix
-    ] if 2array suffix ;
+        drop over last last push
+    ] if ; inline
+
+PRIVATE>
 
 : group-by ( seq quot: ( elt -- key ) -- groups )
-    '[ dup _ call( x -- y ) rot (group-by-loop) ] { } swap reduce ;
+    '[ dup _ call( x -- y ) (group-by) ] V{ } clone swap reduce ;