sequences.extras: adding supremum-by and infimum-by that call the "map" quot once...

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 5faff7763429041eff54cfb335b33a7abb7ca6ee..07ca0c3e22b528e1f0b753b1adc2f7d622c98e7c 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -45,6 +45,18 @@ IN: sequences.extras
 : minimum ( seq quot: ( ... elt -- ... x ) -- elt )
     [ dup ?first ] dip [ min-by ] curry reduce ; inline
 
+: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt )
+    [ [ first dup ] dip call ] 2keep [
+        dupd call pick dupd max over =
+        [ [ 2drop ] 2dip ] [ 2nip ] if
+    ] curry 1 each-from drop ; inline
+
+: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt )
+    [ [ first dup ] dip call ] 2keep [
+        dupd call pick dupd min over =
+        [ [ 2drop ] 2dip ] [ 2nip ] if
+    ] curry 1 each-from drop ; inline
+
 : all-subseqs ( seq -- seqs )
     dup length [1,b] [ <clumps> ] with map concat ;