grouping.extras: adding ngroup-map and some utility words.

pad-group extends a sequence to make sure the last group if full.
short-group slices a sequence to make sure groups all same size.

diff --git a/extra/grouping/extras/extras-tests.factor b/extra/grouping/extras/extras-tests.factor
index c02e268f1bc618dd46b8547981a26abc6eec2bfa..85741278e7b3d00d4a48e17371e8c648343e1d83 100644 (file)
--- a/extra/grouping/extras/extras-tests.factor
+++ b/extra/grouping/extras/extras-tests.factor
@@ -16,6 +16,11 @@ sequences tools.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
+
 { { "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 ca7b200ab1145aa1a48916d1cef39d380b574124..af230c0b7a359a17226a54e00feeb9be6a2b0bfc 100644 (file)
--- a/extra/grouping/extras/extras.factor
+++ b/extra/grouping/extras/extras.factor
@@ -25,6 +25,18 @@ MACRO: nclump-map-as ( seq quot exemplar n -- result )
 : nclump-map ( seq quot n -- result )
     { } swap nclump-map-as ; inline
 
+:: pad-groups ( seq n elt -- padded )
+    seq dup length dup n mod [ drop ] [ n swap - + elt pad-tail ] if-zero ;
+
+:: 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 ] ;
+
+: ngroup-map ( seq quot n -- result )
+    { } swap ngroup-map-as ; inline
+
 TUPLE: head-clumps seq ;
 C: <head-clumps> head-clumps
 M: head-clumps length seq>> length ;