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

sequences: More efficient longest and shortest by moving infimum-by/supremum-by into core.

db4
Doug Coleman 2013-03-11 18:33:54 -07:00
parent b51de731c2
commit 247f57b828
4 changed files with 43 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
core/sequences/sequences-tests.factor
View File

@ -1,7 +1,7 @@
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
@ -351,3 +351,27 @@ USE: make
[ { } { } [ [ 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

21
core/sequences/sequences.factor
View File

@ -1016,11 +1016,26 @@ M: object sum 0 [ + ] binary-reduce ; inline
: 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 ;

23
extra/sequences/extras/extras-tests.factor
View File

@ -4,29 +4,6 @@ tools.test ;
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

15
extra/sequences/extras/extras.factor
View File

@ -28,24 +28,9 @@ IN: sequences.extras
: 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 ;