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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

18
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 kernel macros math
math.ranges sequences sequences.generalizations math.ranges sequences sequences.generalizations
sequences.private ; sequences.private vectors ;
IN: grouping.extras IN: grouping.extras
@ -49,12 +49,16 @@ INSTANCE: tail-clumps immutable-sequence
: group-as ( seq n exemplar -- array ) : group-as ( seq n exemplar -- array )
[ <groups> ] dip [ like ] curry map ; [ <groups> ] dip [ like ] curry map ;
: (group-by-loop) ( elt key groups -- groups' ) <PRIVATE
2dup [ nip empty? ] [ ?last ?first = not ] 2bi or [
-rot swap 1array : (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 drop over last last push
] if 2array suffix ; ] if ; inline
PRIVATE>
: group-by ( seq quot: ( elt -- key ) -- groups ) : 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 ;