grouping.extras: better {clump,group}-map.

Specifically, clump-map is faster and both clump-map and group-map are
improved to call non-inlined sequences.

diff --git a/extra/grouping/extras/extras-tests.factor b/extra/grouping/extras/extras-tests.factor
index 85741278e7b3d00d4a48e17371e8c648343e1d83..957ed380ad3d5157e61add45e618860bdc651d6d 100644 (file)
--- a/extra/grouping/extras/extras-tests.factor
+++ b/extra/grouping/extras/extras-tests.factor
@@ -1,25 +1,25 @@
 USING: arrays grouping.extras kernel math math.functions
 sequences tools.test ;
 
-{ { } } [ { 1 } [ 2array ] 2clump-map ] unit-test
-{ { { 1 2 } } } [ { 1 2 } [ 2array ] 2clump-map ] unit-test
-{ { { 1 2 } { 2 3 } } } [ { 1 2 3 } [ 2array ] 2clump-map ] unit-test
-{ { { 1 2 } { 2 3 } { 3 4 } } } [ { 1 2 3 4 } [ 2array ] 2clump-map ] unit-test
-
-{ { } } [ { 1 } [ 3array ] 3clump-map ] unit-test
-{ { } } [ { 1 2 } [ 3array ] 3clump-map ] unit-test
-{ { { 1 2 3 } } } [ { 1 2 3 } [ 3array ] 3clump-map ] unit-test
-{ { { 1 2 3 } { 2 3 4 } } } [ { 1 2 3 4 } [ 3array ] 3clump-map ] unit-test
-
-{ { } } [ { 1 } [ 4array ] 4 nclump-map ] unit-test
-{ { } } [ { 1 2 } [ 4array ] 4 nclump-map ] unit-test
-{ { { 1 2 3 4 } } } [ { 1 2 3 4 } [ 4array ] 4 nclump-map ] unit-test
-{ { { 1 2 3 4 } { 2 3 4 5 } } } [ { 1 2 3 4 5 } [ 4array ] 4 nclump-map ] unit-test
-
-{ { } } [ { 1 } [ 3array ] 3 ngroup-map ] unit-test
-{ { } } [ { 1 2 } [ 3array ] 3 ngroup-map ] unit-test
-{ { { 1 2 3 } } } [ { 1 2 3 } [ 3array ] 3 ngroup-map ] unit-test
-{ { { 1 2 3 } } } [ { 1 2 3 4 } [ 3array ] 3 ngroup-map ] unit-test
+{ { } } [ { 1 } [ 2array ] 2 clump-map ] unit-test
+{ { { 1 2 } } } [ { 1 2 } [ 2array ] 2 clump-map ] unit-test
+{ { { 1 2 } { 2 3 } } } [ { 1 2 3 } [ 2array ] 2 clump-map ] unit-test
+{ { { 1 2 } { 2 3 } { 3 4 } } } [ { 1 2 3 4 } [ 2array ] 2 clump-map ] unit-test
+
+{ { } } [ { 1 } [ 3array ] 3 clump-map ] unit-test
+{ { } } [ { 1 2 } [ 3array ] 3 clump-map ] unit-test
+{ { { 1 2 3 } } } [ { 1 2 3 } [ 3array ] 3 clump-map ] unit-test
+{ { { 1 2 3 } { 2 3 4 } } } [ { 1 2 3 4 } [ 3array ] 3 clump-map ] unit-test
+
+{ { } } [ { 1 } [ 4array ] 4 clump-map ] unit-test
+{ { } } [ { 1 2 } [ 4array ] 4 clump-map ] unit-test
+{ { { 1 2 3 4 } } } [ { 1 2 3 4 } [ 4array ] 4 clump-map ] unit-test
+{ { { 1 2 3 4 } { 2 3 4 5 } } } [ { 1 2 3 4 5 } [ 4array ] 4 clump-map ] unit-test
+
+{ { } } [ { 1 } [ 3array ] 3 group-map ] unit-test
+{ { } } [ { 1 2 } [ 3array ] 3 group-map ] unit-test
+{ { { 1 2 3 } } } [ { 1 2 3 } [ 3array ] 3 group-map ] unit-test
+{ { { 1 2 3 } } } [ { 1 2 3 4 } [ 3array ] 3 group-map ] unit-test
 
 { { "tail" "ail" "il" "l" } } [ "tail" tail-clump ] unit-test
 { { "h" "he" "hea" "head" } } [ "head" head-clump ] unit-test

diff --git a/extra/grouping/extras/extras.factor b/extra/grouping/extras/extras.factor
index af230c0b7a359a17226a54e00feeb9be6a2b0bfc..7ed07da895eaa4ffb9cc0c47d024d65b998ae9eb 100644 (file)
--- a/extra/grouping/extras/extras.factor
+++ b/extra/grouping/extras/extras.factor
@@ -1,29 +1,22 @@
-USING: accessors arrays combinators fry grouping
-grouping.private kernel locals macros math math.ranges sequences
-sequences.generalizations sequences.private vectors ;
+USING: accessors arrays combinators fry generalizations grouping
+grouping.private kernel locals macros math math.order math.ranges
+sequences sequences.generalizations sequences.private vectors ;
 
 IN: grouping.extras
 
-: 2clump-map-as ( seq quot: ( elt1 elt2 -- newelt ) exemplar -- seq' )
-    [ dup 1 short tail-slice ] 2dip 2map-as ; inline
-
-: 2clump-map ( seq quot: ( elt1 elt2 -- newelt ) -- seq' )
-    { } 2clump-map-as ; inline
-
-: 3clump-map-as ( seq quot: ( elt1 elt2 elt3 -- newelt ) exemplar -- seq' )
+MACRO:: clump-map-as ( quot exemplar n -- result )
+    n 1 - :> n-1
     [
-        dup [ 1 short tail-slice ] [ 2 short tail-slice ] bi
-    ] 2dip 3map-as ; inline
-
-: 3clump-map ( seq quot: ( elt1 elt2 elt3 -- newelt ) -- seq' )
-    { } 3clump-map-as ; inline
-
-MACRO: nclump-map-as ( seq quot exemplar n -- result )
-    [ nip [1,b) [ [ short tail-slice ] curry ] map swap ] 2keep
-    '[ _ dup _ cleave _ _ _ nmap-as ] ;
+        dup length n < [
+            drop { } exemplar like
+        ] [
+            [ n-1 firstn ] [ n-1 tail-slice ] bi
+            [ quot n-1 nkeep n nrot ] exemplar map-as n-1 nnip
+        ] if
+    ] ;
 
-: nclump-map ( seq quot n -- result )
-    { } swap nclump-map-as ; inline
+: clump-map ( seq quot n -- result )
+    { } swap clump-map-as ; inline
 
 :: pad-groups ( seq n elt -- padded )
     seq dup length dup n mod [ drop ] [ n swap - + elt pad-tail ] if-zero ;
@@ -31,11 +24,12 @@ MACRO: nclump-map-as ( seq quot exemplar n -- result )
 :: short-groups ( seq n -- seq' )
     seq dup length dup n mod [ drop ] [ - head-slice ] if-zero ;
 
-MACRO:: ngroup-map-as ( seq quot exemplar n -- result )
-    [ seq n short-groups n <groups> [ n firstn quot call ] exemplar map-as ] ;
+:: group-map-as ( seq quot exemplar n -- result )
+    seq n short-groups n <groups>
+    [ n firstn quot call ] exemplar map-as ; inline
 
-: ngroup-map ( seq quot n -- result )
-    { } swap ngroup-map-as ; inline
+: group-map ( seq quot n -- result )
+    { } swap group-map-as ; inline
 
 TUPLE: head-clumps seq ;
 C: <head-clumps> head-clumps