sequences.extras: Check if slices overlap or touch. Add a merge-slices word. For efficiency, provide ordered/unordered versions of each word based on whether you know the slices have been swapped or not so they are ordered by from>>.
parent
b4f979c848
commit
fc1b8214f0
|
@ -52,6 +52,26 @@ IN: sequences.extras.tests
|
|||
{ "abc" }
|
||||
[ "abc" sequence>slice >string ] unit-test
|
||||
|
||||
{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 2 4 rot <slice> ] bi slices-overlap? ] unit-test
|
||||
{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 1 2 rot <slice> ] bi slices-overlap? ] unit-test
|
||||
{ f } [ "abcdef" [ 0 3 rot <slice> ] [ 3 6 rot <slice> ] bi slices-overlap? ] unit-test
|
||||
{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 2 4 rot <slice> ] bi slices-touch? ] unit-test
|
||||
{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 1 2 rot <slice> ] bi slices-touch? ] unit-test
|
||||
{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 3 6 rot <slice> ] bi slices-touch? ] unit-test
|
||||
{ f } [ "abcdef" [ 0 3 rot <slice> ] [ 4 6 rot <slice> ] bi slices-touch? ] unit-test
|
||||
|
||||
{ "abcdef" } [
|
||||
"abcdef" [ 0 3 rot <slice> ] [ 3 6 rot <slice> ] bi merge-slices >string
|
||||
] unit-test
|
||||
|
||||
{ "abcdef" } [
|
||||
"abcdef" [ 3 6 rot <slice> ] [ 0 3 rot <slice> ] bi merge-slices >string
|
||||
] unit-test
|
||||
|
||||
{ "abc" } [
|
||||
"abcdef" [ 0 3 rot <slice> ] [ 0 3 rot <slice> ] bi merge-slices >string
|
||||
] unit-test
|
||||
|
||||
|
||||
{ "hello" } [ "hello" 0 rotate-headwards ] unit-test
|
||||
{ "llohe" } [ "hello" 2 rotate-headwards ] unit-test
|
||||
|
|
|
@ -158,6 +158,42 @@ PRIVATE>
|
|||
: sequence>slice ( sequence -- slice )
|
||||
[ drop 0 ] [ length ] [ ] tri <slice> ; inline
|
||||
|
||||
: slice-order-by-from ( slice1 slice2 -- slice-lt slice-gt )
|
||||
2dup [ from>> ] bi@ > [ swap ] when ; inline
|
||||
|
||||
: ordered-slices-range ( slice-lt slice-gt -- to from )
|
||||
[ to>> ] [ from>> ] bi* ;
|
||||
|
||||
: unordered-slices-range ( slice1 slice2 -- to from )
|
||||
slice-order-by-from ordered-slices-range ;
|
||||
|
||||
: ordered-slices-overlap? ( slice-lt slice-gt -- ? )
|
||||
ordered-slices-range > ; inline
|
||||
|
||||
: unordered-slices-overlap? ( slice1 slice2 -- ? )
|
||||
unordered-slices-range > ; inline
|
||||
|
||||
: slices-overlap? ( slice1 slice2 -- ? )
|
||||
unordered-slices-overlap? ;
|
||||
|
||||
: ordered-slices-touch? ( slice-lt slice-gt -- ? )
|
||||
ordered-slices-range >= ; inline
|
||||
|
||||
: unordered-slices-touch? ( slice1 slice2 -- ? )
|
||||
unordered-slices-range >= ; inline
|
||||
|
||||
: slices-touch? ( slice1 slice2 -- ? )
|
||||
unordered-slices-touch? ;
|
||||
|
||||
ERROR: slices-don't-touch slice1 slice2 ;
|
||||
: merge-slices ( slice1 slice2 -- slice/* )
|
||||
slice-order-by-from
|
||||
2dup ordered-slices-touch? [
|
||||
[ from>> ] [ [ to>> ] [ seq>> ] bi ] bi* <slice>
|
||||
] [
|
||||
slices-don't-touch
|
||||
] if ;
|
||||
|
||||
: length- ( n sequence -- m ) length swap - ; inline
|
||||
|
||||
: rotate-headwards ( seq n -- seq' )
|
||||
|
|
Loading…
Reference in New Issue