sequences.extras: adding all-subseqs, each-subseq, longest-subseq, and generalized minimum/maximum words.
parent
1c66fbf086
commit
c6bd2313ba
extra/sequences/extras
|
@ -0,0 +1,23 @@
|
|||
USING: make sequences sequences.extras tools.test ;
|
||||
|
||||
IN: sequences.extras.tests
|
||||
|
||||
[ 1 ] [ 1 2 [ ] min-by ] unit-test
|
||||
[ 2 ] [ 1 2 [ ] max-by ] unit-test
|
||||
[ "12345" ] [ "123" "12345" [ length ] max-by ] unit-test
|
||||
[ "123" ] [ "123" "12345" [ length ] min-by ] unit-test
|
||||
|
||||
[ 4 ] [ 5 iota [ ] maximum ] unit-test
|
||||
[ 0 ] [ 5 iota [ ] minimum ] unit-test
|
||||
[ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] maximum ] unit-test
|
||||
[ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] minimum ] unit-test
|
||||
|
||||
[ { "a" "b" "c" "d" "ab" "bc" "cd" "abc" "bcd" "abcd" } ] [ "abcd" all-subseqs ] unit-test
|
||||
|
||||
[ { "a" "ab" "abc" "abcd" "b" "bc" "bcd" "c" "cd" "d" } ]
|
||||
[ [ "abcd" [ , ] each-subseq ] { } make ] unit-test
|
||||
|
||||
[ "" ] [ "abc" "def" longest-subseq ] unit-test
|
||||
[ "abcd" ] [ "abcd" "abcde" longest-subseq ] unit-test
|
||||
[ "foo" ] [ "foo" "foobar" longest-subseq ] unit-test
|
||||
[ "foo" ] [ "foobar" "foo" longest-subseq ] unit-test
|
|
@ -1,5 +1,8 @@
|
|||
USING: arrays kernel locals math sequences ;
|
||||
USING: arrays grouping kernel locals math math.order math.ranges
|
||||
sequences ;
|
||||
|
||||
IN: sequences.extras
|
||||
|
||||
: reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
|
||||
|
||||
:: reduce-r
|
||||
|
@ -18,4 +21,48 @@ IN: sequences.extras
|
|||
: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
|
||||
[ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
|
||||
|
||||
: insert-sorted ( elt seq -- seq ) 2dup [ < ] with find drop over length or swap insert-nth ;
|
||||
: insert-sorted ( elt seq -- seq ) 2dup [ < ] with find drop over length or swap insert-nth ;
|
||||
|
||||
: max-by ( obj1 obj2 quot: ( obj -- n ) -- obj1/obj2 )
|
||||
[ bi@ [ max ] keep eq? not ] curry most ; inline
|
||||
|
||||
: min-by ( obj1 obj2 quot: ( obj -- n ) -- obj1/obj2 )
|
||||
[ bi@ [ min ] keep eq? not ] curry most ; inline
|
||||
|
||||
: maximum ( seq quot: ( ... elt -- ... x ) -- elt )
|
||||
[ keep 2array ] curry
|
||||
[ [ first ] max-by ] map-reduce second ; inline
|
||||
|
||||
: minimum ( seq quot: ( ... elt -- ... x ) -- elt )
|
||||
[ keep 2array ] curry
|
||||
[ [ first ] min-by ] map-reduce second ; inline
|
||||
|
||||
: all-subseqs ( seq -- seqs )
|
||||
dup length [1,b] [ <clumps> ] with map concat ;
|
||||
|
||||
:: each-subseq ( ... seq quot: ( ... x -- ... ) -- ... )
|
||||
seq length [0,b] [
|
||||
:> from
|
||||
from seq length (a,b] [
|
||||
:> to
|
||||
from to seq subseq quot call( x -- )
|
||||
] each
|
||||
] each ;
|
||||
|
||||
:: longest-subseq ( seq1 seq2 -- subseq )
|
||||
seq1 length :> len1
|
||||
seq2 length :> len2
|
||||
0 :> n!
|
||||
0 :> end!
|
||||
len1 1 + [ len2 1 + 0 <array> ] replicate :> table
|
||||
len1 [1,b] [| x |
|
||||
len2 [1,b] [| y |
|
||||
x 1 - seq1 nth
|
||||
y 1 - seq2 nth = [
|
||||
y 1 - x 1 - table nth nth 1 + :> len
|
||||
len y x table nth set-nth
|
||||
len n > [ len n! x end! ] when
|
||||
] [ 0 y x table nth set-nth ] if
|
||||
] each
|
||||
] each end n - end seq1 subseq ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue