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

Merge remote-tracking branch 'origin/master' into modern-harvey

modern-harvey2
Doug Coleman 2017-09-18 17:37:25 -05:00
parent 4b065d4790 ab55560fed
commit 03db55e15b
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
{ 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
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 ;