tools.test vectors vocabs ;
IN: sequences.extras.tests
-{ { { 0 104 } { 2 108 } { 3 108 } } } [ "hello" [ even? ] find-all ] unit-test
+{ V{ { 0 104 } { 2 108 } { 3 108 } } } [ "hello" [ even? ] find-all ] unit-test
{ { "a" "b" "c" "d" "ab" "bc" "cd" "abc" "bcd" "abcd" } } [ "abcd" all-subseqs ] unit-test
{ "abc" } [ "abc" [ 1string ] map-concat ] unit-test
{ "abc" } [ { 97 98 99 } [ 1string ] map-concat ] unit-test
{ { 97 98 99 } } [ "abc" [ 1string ] { } map-concat-as ] unit-test
-{ "baz" { "foobaz" "barbaz" } }
-[ "baz" { { "foo" } { "bar" } } [ [ over append ] map ] map-concat ] unit-test
+{ { "foobaz" "barbaz" } }
+[ "baz" { { "foo" } { "bar" } } [ [ prepend ] with map ] with map-concat ] unit-test
{ { } } [ { } [ ] [ even? ] map-filter ] unit-test
{ "bcde" } [ "abcd" [ 1 + ] [ drop t ] map-filter ] unit-test
: all-subseqs ( seq -- seqs )
dup length [1,b] [ clump ] with map concat ;
-:: each-subseq ( ... seq quot: ( ... x -- ... ) -- ... )
+:: each-subseq ( ... seq quot: ( ... subseq -- ... ) -- ... )
seq length :> len
- len [0,b] [
- :> from
- from len (a,b] [
- :> to
+ len [0,b] [| from |
+ from len (a,b] [| to |
from to seq subseq quot call
] each
] each ; inline
: map-like ( seq exemplar -- seq' )
'[ _ like ] map ; inline
-: filter-all-subseqs-range ( ... seq range quot: ( ... x -- ... ) -- seq )
+: filter-all-subseqs-range ( ... seq range quot: ( ... subseq -- ... ) -- seq )
[
'[ <clumps> _ filter ] with map concat
] 3keep 2drop map-like ; inline
-: filter-all-subseqs ( ... seq quot: ( ... x -- ... ) -- seq )
+: filter-all-subseqs ( ... seq quot: ( ... subseq -- ... ) -- seq )
[ dup length [1,b] ] dip filter-all-subseqs-range ; inline
:: longest-subseq ( seq1 seq2 -- subseq )
over length mod dup 0 >= [ cut ] [ abs cut* ] if prepend ;
ERROR: underlying-mismatch slice1 slice2 ;
+
: ensure-same-underlying ( slice1 slice2 -- slice1 slice2 )
2dup [ seq>> ] bi@ eq? [ underlying-mismatch ] unless ;
: map-concat ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
over empty? [ 2drop { } ] [
- [ [ first ] dip call ] 2keep rot dup [
- >resizable [ [ push-all ] curry compose ] keep
- [ 1 ] 3dip [ setup-each (each-integer) ] dip
- ] curry dip like
+ [ [ first ] dip call ] 2keep pick [
+ [ >resizable ] 2dip [ append! ] compose 1 each-from
+ ] dip like
] if ; inline
: map-filter-as ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) exemplar -- ... subseq )