grouping.extras: add <n-groups> and n-group.

diff --git a/extra/grouping/extras/extras-tests.factor b/extra/grouping/extras/extras-tests.factor
index 7b386af4e17b26e6f0edd8f413b208032c62135c..3b8f802514591415580133d89f18646b8ad1154d 100644 (file)
--- a/extra/grouping/extras/extras-tests.factor
+++ b/extra/grouping/extras/extras-tests.factor
@@ -36,3 +36,9 @@ IN: grouping.extras
 [ 10 <iota> [ drop t ] group-by ] unit-test
 
 { V{ } } [ { } [ drop t ] group-by ] unit-test
+
+{ { { } { } { } } } [ { } 3 n-group ] unit-test
+{ { { 1 } { } { } } } [ { 1 } 3 n-group ] unit-test
+{ { { 1 } { 2 } { } } } [ { 1 2 } 3 n-group ] unit-test
+{ { { 1 } { 2 } { 3 } } } [ { 1 2 3 } 3 n-group ] unit-test
+{ { { 1 2 } { 3 } { 4 } } } [ { 1 2 3 4 } 3 n-group ] unit-test

diff --git a/extra/grouping/extras/extras.factor b/extra/grouping/extras/extras.factor
index b86f9d851bfeabd15ce19eb4dd3f70db69ca2410..ca7b200ab1145aa1a48916d1cef39d380b574124 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 vectors ;
+USING: accessors arrays combinators fry grouping
+grouping.private kernel locals macros math math.ranges sequences
+sequences.generalizations sequences.private vectors ;
 
 IN: grouping.extras
 
@@ -62,3 +62,16 @@ PRIVATE>
 
 : group-by ( seq quot: ( elt -- key ) -- groups )
     '[ dup _ call( x -- y ) (group-by) ] V{ } clone swap reduce ;
+
+:: <n-groups> ( seq n -- groups )
+    seq length :> len
+    len n /mod :> ( step rem! )
+    0 n [
+        dup len < [
+            dup step + rem zero? [ 1 + rem 1 - rem! ] unless
+            [ seq <slice> ] keep swap
+        ] [ f ] if
+    ] replicate nip ;
+
+: n-group ( seq n -- groups )
+    [ <n-groups> ] map-like ;