grouping.extras: group-by is faster with vectors.

db4
John Benediktsson 2013-12-18 09:30:25 -08:00
parent 066866c539
commit 186f1e11d9
2 changed files with 21 additions and 20 deletions

View File

@ -22,20 +22,17 @@ IN: grouping.extras
{ { B{ 97 115 } B{ 100 102 } } } [ "asdf" 2 B{ } group-as ] unit-test
{ { { 97 115 } { 115 100 } { 100 102 } } } [ "asdf" 2 { } clump-as ] unit-test
[
{
{ 0 { 0 1 2 } }
{ 1 { 3 4 5 } }
{ 2 { 6 7 8 } }
{ 3 { 9 } } }
] [
{
V{
{ 0 V{ 0 1 2 } }
{ 1 V{ 3 4 5 } }
{ 2 V{ 6 7 8 } }
{ 3 V{ 9 } } }
} [
10 iota [ 3 / floor ] group-by
] unit-test
[
{ { t { 0 1 2 3 4 5 6 7 8 9 } } }
] [ 10 iota [ drop t ] group-by ] unit-test
{ V{ { t V{ 0 1 2 3 4 5 6 7 8 9 } } } }
[ 10 iota [ drop t ] group-by ] unit-test
[
{ }
] [ { } [ drop t ] group-by ] unit-test
{ V{ } } [ { } [ drop t ] group-by ] unit-test

View File

@ -1,6 +1,6 @@
USING: accessors arrays combinators fry grouping kernel macros math
math.ranges sequences sequences.generalizations
sequences.private ;
sequences.private vectors ;
IN: grouping.extras
@ -49,12 +49,16 @@ INSTANCE: tail-clumps immutable-sequence
: group-as ( seq n exemplar -- array )
[ <groups> ] dip [ like ] curry map ;
: (group-by-loop) ( elt key groups -- groups' )
2dup [ nip empty? ] [ ?last ?first = not ] 2bi or [
-rot swap 1array
<PRIVATE
: (group-by) ( elt key groups -- groups' )
pick [ t ] [ last first dupd = not ] if-empty [
swap 1vector 2array over push
] [
nip unclip-last rot [ first2 ] dip suffix
] if 2array suffix ;
drop over last last push
] if ; inline
PRIVATE>
: group-by ( seq quot: ( elt -- key ) -- groups )
'[ dup _ call( x -- y ) rot (group-by-loop) ] { } swap reduce ;
'[ dup _ call( x -- y ) (group-by) ] V{ } clone swap reduce ;