diff --git a/extra/grouping/extras/extras-tests.factor b/extra/grouping/extras/extras-tests.factor index 7b386af4e1..3b8f802514 100644 --- a/extra/grouping/extras/extras-tests.factor +++ b/extra/grouping/extras/extras-tests.factor @@ -36,3 +36,9 @@ IN: grouping.extras [ 10 [ 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 b86f9d851b..ca7b200ab1 100644 --- 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 ; + +:: ( 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 ] keep swap + ] [ f ] if + ] replicate nip ; + +: n-group ( seq n -- groups ) + [ ] map-like ;