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

Allow circular clumps with a length smaller than the clump 

Conflicts:
	basis/grouping/grouping-tests.factor
db4
Jon Harper 2012-10-28 13:12:46 +01:00 committed by Doug Coleman
parent 0dfe8f949c
commit 93cf443f32
3 changed files with 7 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/grouping/grouping-docs.factor
View File

@ -125,7 +125,7 @@ HELP: clump
HELP: circular-clump HELP: circular-clump
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } } { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements, wrapping around the end of the sequence, and collects the clumps into a new array." } { $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements, wrapping around the end of the sequence, and collects the clumps into a new array." }
{ $errors "Throws an error if " { $snippet "n" } " is larger than the length of the sequence." } { $notes "For an empty sequence, the result is an empty sequence." }
{ $examples { $examples
{ $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 circular-clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } { 7 3 } }" } { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 circular-clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } { 7 3 } }" }
} ; } ;

5
basis/grouping/grouping-tests.factor
View File

@ -21,12 +21,13 @@ IN: grouping.tests
{ { { 1 2 } } } [ { 1 2 } 2 clump ] unit-test { { { 1 2 } } } [ { 1 2 } 2 clump ] unit-test
{ { { 1 2 } { 2 3 } } } [ { 1 2 3 } 2 clump ] unit-test { { { 1 2 } { 2 3 } } } [ { 1 2 3 } 2 clump ] unit-test
[ { } 2 <circular-clumps> length ] must-fail { 0 } [ { } 2 <circular-clumps> length ] unit-test
[ { 1 } 2 <circular-clumps> length ] must-fail { 1 } [ { 1 } 2 <circular-clumps> length ] unit-test
[ 2 ] [ { 1 2 } 2 <circular-clumps> length ] unit-test [ 2 ] [ { 1 2 } 2 <circular-clumps> length ] unit-test
[ 3 ] [ { 1 2 3 } 2 <circular-clumps> length ] unit-test [ 3 ] [ { 1 2 3 } 2 <circular-clumps> length ] unit-test
[ { { 1 1 } } ] [ { 1 } 2 circular-clump ] unit-test
[ { { 1 2 } { 2 1 } } ] [ { 1 2 } 2 circular-clump ] unit-test [ { { 1 2 } { 2 1 } } ] [ { 1 2 } 2 circular-clump ] unit-test
[ { { 1 2 } { 2 3 } { 3 1 } } ] [ { 1 2 3 } 2 circular-clump ] unit-test [ { { 1 2 } { 2 3 } { 3 1 } } ] [ { 1 2 3 } 2 circular-clump ] unit-test

12
basis/grouping/grouping.factor
View File

@ -62,12 +62,6 @@ TUPLE: chunking-seq { seq read-only } { n read-only } ;
: new-groups ( seq n class -- groups ) : new-groups ( seq n class -- groups )
[ check-groups ] dip boa ; inline [ check-groups ] dip boa ; inline
: slice-mod ( n length -- n' )
2dup >= [ - ] [ drop ] if ; inline
: check-circular-clumps ( seq n -- seq n )
2dup 1 - swap bounds-check 2drop ; inline
PRIVATE> PRIVATE>
TUPLE: groups < chunking-seq ; TUPLE: groups < chunking-seq ;
@ -129,7 +123,7 @@ M: circular-slice length [ to>> ] [ from>> ] bi - ; inline
M: circular-slice virtual-exemplar seq>> ; inline M: circular-slice virtual-exemplar seq>> ; inline
M: circular-slice virtual@ M: circular-slice virtual@
[ from>> + ] [ seq>> ] bi [ length slice-mod ] keep ; inline [ from>> + ] [ seq>> ] bi [ length rem ] keep ; inline
C: <circular-slice> circular-slice C: <circular-slice> circular-slice
@ -143,7 +137,7 @@ M: sliced-circular-clumps nth
[ n>> over + ] [ seq>> ] bi <circular-slice> ; inline [ n>> over + ] [ seq>> ] bi <circular-slice> ; inline
: <sliced-circular-clumps> ( seq n -- clumps ) : <sliced-circular-clumps> ( seq n -- clumps )
check-circular-clumps sliced-circular-clumps boa ; inline sliced-circular-clumps new-groups ; inline
TUPLE: circular-clumps < chunking-seq ; TUPLE: circular-clumps < chunking-seq ;
INSTANCE: circular-clumps sequence INSTANCE: circular-clumps sequence
@ -155,7 +149,7 @@ M: circular-clumps nth
[ n>> over + ] [ seq>> ] bi [ <circular-slice> ] [ like ] bi ; inline [ n>> over + ] [ seq>> ] bi [ <circular-slice> ] [ like ] bi ; inline
: <circular-clumps> ( seq n -- clumps ) : <circular-clumps> ( seq n -- clumps )
check-circular-clumps circular-clumps boa ; inline circular-clumps new-groups ; inline
: circular-clump ( seq n -- array ) : circular-clump ( seq n -- array )
<circular-clumps> { } like ; inline <circular-clumps> { } like ; inline