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

sequences.extras: fix bug in infimum-by/supremum-by.

db4
John Benediktsson 2012-07-23 07:52:27 -07:00
parent 695e6aea49
commit f1aeea56fb
2 changed files with 18 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,6 +8,22 @@ IN: sequences.extras.tests
[ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test [ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
[ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] infimum-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{ 0 1 2 3 4 5 6 7 8 9 } } [
V{ } clone V{ } clone
10 iota >array randomize 10 iota >array randomize

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

@ -36,13 +36,13 @@ IN: sequences.extras
: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt ) : supremum-by ( seq quot: ( ... elt -- ... x ) -- elt )
[ [ first dup ] dip call ] 2keep [ [ [ first dup ] dip call ] 2keep [
dupd call pick dupd max over = dupd call pick dupd max over =
[ [ 2drop ] 2dip ] [ 2nip ] if [ [ 2drop ] 2dip ] [ 2drop ] if
] curry 1 each-from drop ; inline ] curry 1 each-from drop ; inline
: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt ) : infimum-by ( seq quot: ( ... elt -- ... x ) -- elt )
[ [ first dup ] dip call ] 2keep [ [ [ first dup ] dip call ] 2keep [
dupd call pick dupd min over = dupd call pick dupd min over =
[ [ 2drop ] 2dip ] [ 2nip ] if [ [ 2drop ] 2dip ] [ 2drop ] if
] curry 1 each-from drop ; inline ] curry 1 each-from drop ; inline
: all-subseqs ( seq -- seqs ) : all-subseqs ( seq -- seqs )