diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 70bd01fb98..cf41eb9222 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -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 math.vectors ; +generic.single math.vectors math.functions ; IN: sequences.tests [ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test @@ -359,6 +359,8 @@ USE: make { "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 +{ -2 1 } [ -2 { 1 2 3 } [ over ^ ] supremum-by ] unit-test +{ -2 3 } [ -2 { 1 2 3 } [ over ^ ] infimum-by ] unit-test [ { 0 0 255 } ] [ { diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index f209adfa6f..694c8c4754 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -1031,16 +1031,16 @@ M: object sum 0 [ + ] binary-reduce ; inline : each-from ( ... seq quot: ( ... x -- ... ) i -- ... ) -rot (each) (each-integer) ; inline -: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt ) - [ [ first dup ] dip call ] 2keep [ - dupd call pick dupd after? - [ [ 2drop ] 2dip ] [ 2drop ] if +: supremum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt ) + [ keep swap ] curry [ [ first ] dip call ] 2keep [ + curry 2dip pick over after? + [ 2drop ] [ [ 2drop ] 2dip ] 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 +: infimum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt ) + [ keep swap ] curry [ [ first ] dip call ] 2keep [ + curry 2dip pick over before? + [ 2drop ] [ [ 2drop ] 2dip ] if ] curry 1 each-from drop ; inline : shortest ( seqs -- elt ) [ length ] infimum-by ;