USING: arrays byte-arrays kernel math math.order math.parser
namespaces sequences kernel.private sequences.private strings
sbufs tools.test vectors assocs generic vocabs.loader
-generic.single ;
+generic.single math.vectors ;
IN: sequences.tests
[ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
[ { } { } [ [ string>digits product ] bi@ + ] [ + ] 2map-reduce ] must-infer
[ { } { } [ + ] [ + ] 2map-reduce ] must-fail
[ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test
+
+[ 4 ] [ 5 iota [ ] supremum-by ] unit-test
+[ 0 ] [ 5 iota [ ] infimum-by ] unit-test
+{ "bar" } [ { "bar" "baz" "qux" } [ length ] supremum-by ] unit-test
+{ "bar" } [ { "bar" "baz" "qux" } [ length ] infimum-by ] unit-test
+[ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
+[ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] infimum-by ] unit-test
+
+[ { 0 0 255 } ] [
+ {
+ { 0 0 0 }
+ { 95 255 95 }
+ { 215 95 95 }
+ { 95 135 255 }
+ { 135 95 135 }
+ { 135 255 255 }
+ { 0 0 255 }
+ { 0 95 95 }
+ { 0 255 215 }
+ { 135 0 95 }
+ { 255 0 175 }
+ } [ { 0 0 255 } distance ] infimum-by
+] unit-test
+
: cartesian-product ( seq1 seq2 -- newseq )
[ { } 2sequence ] cartesian-map ;
-: filter-length ( seq n -- seq' ) [ swap length = ] curry filter ;
+: each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
+ -rot (each) (each-integer) ; inline
-: shortest ( seqs -- elt ) [ ] [ shorter ] map-reduce ;
+: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt )
+ [ [ first dup ] dip call ] 2keep [
+ dupd call pick dupd after?
+ [ [ 2drop ] 2dip ] [ 2drop ] if
+ ] curry 1 each-from drop ; inline
-: longest ( seqs -- elt ) [ ] [ longer ] map-reduce ;
+: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt )
+ [ [ first dup ] dip call ] 2keep [
+ dupd call pick dupd before?
+ [ [ 2drop ] 2dip ] [ 2drop ] if
+ ] curry 1 each-from drop ; inline
+
+: filter-length ( seq n -- seq' ) swap [ length = ] with filter ;
+
+: shortest ( seqs -- elt ) [ length ] infimum-by ;
+
+: longest ( seqs -- elt ) [ length ] supremum-by ;
: all-shortest ( seqs -- seqs' ) dup shortest length filter-length ;
IN: sequences.extras.tests
-[ 4 ] [ 5 iota [ ] supremum-by ] unit-test
-[ 0 ] [ 5 iota [ ] infimum-by ] unit-test
-{ "bar" } [ { "bar" "baz" "qux" } [ length ] supremum-by ] unit-test
-{ "bar" } [ { "bar" "baz" "qux" } [ length ] infimum-by ] unit-test
-[ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
-[ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] infimum-by ] unit-test
-
-[ { 0 0 255 } ] [
- {
- { 0 0 0 }
- { 95 255 95 }
- { 215 95 95 }
- { 95 135 255 }
- { 135 95 135 }
- { 135 255 255 }
- { 0 0 255 }
- { 0 95 95 }
- { 0 255 215 }
- { 135 0 95 }
- { 255 0 175 }
- } [ { 0 0 255 } distance ] infimum-by
-] unit-test
-
{ V{ 0 1 2 3 4 5 6 7 8 9 } } [
V{ } clone
10 iota >array randomize
: insert-sorted ( elt seq -- seq )
2dup [ < ] with find drop over length or swap insert-nth ;
-: each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
- -rot (each) (each-integer) ; inline
-
: reduce-from ( ... seq identity quot: ( ... prev elt -- ... next ) i -- ... result )
[ swap ] 2dip each-from ; inline
-: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt )
- [ [ first dup ] dip call ] 2keep [
- dupd call pick dupd after?
- [ [ 2drop ] 2dip ] [ 2drop ] if
- ] curry 1 each-from drop ; inline
-
-: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt )
- [ [ first dup ] dip call ] 2keep [
- dupd call pick dupd before?
- [ [ 2drop ] 2dip ] [ 2drop ] if
- ] curry 1 each-from drop ; inline
-
: all-subseqs ( seq -- seqs )
dup length [1,b] [ <clumps> ] with map concat ;