steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

factor-shell
John Benediktsson 2017-09-18 14:51:58 -07:00
parent 705e7018c8
commit ab55560fed
2 changed files with 22 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/grouping/extras/extras-tests.factor
View File

@ -36,3 +36,9 @@ IN: grouping.extras
[ 10 <iota> [ drop t ] group-by ] unit-test [ 10 <iota> [ drop t ] group-by ] unit-test
{ V{ } } [ { } [ 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

19
extra/grouping/extras/extras.factor
View File

@ -1,6 +1,6 @@
USING: accessors arrays combinators fry grouping kernel macros math USING: accessors arrays combinators fry grouping
math.ranges sequences sequences.generalizations grouping.private kernel locals macros math math.ranges sequences
sequences.private vectors ; sequences.generalizations sequences.private vectors ;
IN: grouping.extras IN: grouping.extras
@ -62,3 +62,16 @@ PRIVATE>
: group-by ( seq quot: ( elt -- key ) -- groups ) : group-by ( seq quot: ( elt -- key ) -- groups )
'[ dup _ call( x -- y ) (group-by) ] V{ } clone swap reduce ; '[ 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 ;