sequences.extras: add ?supremum and ?infimum

diff --git a/extra/sequences/extras/extras-docs.factor b/extra/sequences/extras/extras-docs.factor
index db59a82c59eed643fcd623c69747f35ee5e037a2..3f77165e22c04a730500e126fe7f06db1933ca5b 100644 (file)
--- a/extra/sequences/extras/extras-docs.factor
+++ b/extra/sequences/extras/extras-docs.factor
@@ -1,6 +1,32 @@
 USING: help.markup help.syntax kernel math sequences ;
 IN: sequences.extras
 
+HELP: ?supremum
+{ $values
+    { "seq/f" { $maybe sequence } }
+    { "elt/f" { $maybe object } }
+}
+{ $description "Outputs the greatest element of " { $snippet "seq" } ", ignoring any " { $link POSTPONE: f } " elements in it. If " { $snippet "seq" } " is empty or " { $link POSTPONE: f } ", returns " { $link POSTPONE: f } "." }
+{ $examples
+    { $example "USING: prettyprint sequences.extras ;"
+    "{ 1 f 3 2 } ?supremum ."
+    "3" }
+} ;
+
+HELP: ?infimum
+{ $values
+    { "seq/f" { $maybe sequence } }
+    { "elt/f" { $maybe object } }
+}
+{ $description "Outputs the least element of " { $snippet "seq" } ", ignoring any " { $link POSTPONE: f } " elements in it. If " { $snippet "seq" } " is empty or " { $link POSTPONE: f } ", returns " { $link POSTPONE: f } "." }
+{ $examples
+    { $example "USING: prettyprint sequences.extras ;"
+    "{ 1 f 3 2 } ?infimum ."
+    "1" }
+} ;
+
+{ ?supremum ?infimum } related-words
+
 HELP: 2count
 { $values
     { "seq1" sequence }

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 3996c92176a8107bb91793b1f37c73ae38287649..85a88798b4fde67f43ae0d687c15fb4db3e2c0fb 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -223,6 +223,16 @@ IN: sequences.extras.tests
 { 1 "beef" } [ { "chicken" "beef" "moose" } [ length ] infimum-by* ] unit-test
 { 0 "chicken" } [ { "chicken" "beef" "moose" } [ length ] supremum-by* ] unit-test
 { 2 "moose" } [ { "chicken" "beef" "moose" } [ first ] supremum-by* ] unit-test
+{ f } [ f ?supremum ] unit-test
+{ f } [ { } ?supremum ] unit-test
+{ f } [ { f } ?supremum ] unit-test
+{ 3 } [ { 1 f 3 2 } ?supremum ] unit-test
+{ 3 } [ { 1 3 2 } ?supremum ] unit-test
+{ f } [ f ?infimum ] unit-test
+{ f } [ { } ?infimum ] unit-test
+{ f } [ { f } ?infimum ] unit-test
+{ 1 } [ { 1 f 3 2 } ?infimum ] unit-test
+{ 1 } [ { 1 3 2 } ?infimum ] unit-test
 
 { 3/10 } [ 10 <iota> [ 3 < ] count* ] unit-test
 

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 0832d15a46248e67b95a79f71dcdebab08eb7558..c26f4869eefc408db6faaffc0d6935a8ae1970f5 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -559,6 +559,16 @@ PRIVATE>
 : infimum-by* ( ... seq quot: ( ... elt -- ... x ) -- ... i elt )
     [ before? ] select-by* ; inline
 
+: ?supremum ( seq/f -- elt/f )
+    [ f ] [
+        [ ] [ 2dup and [ max ] [ dupd ? ] if ] map-reduce
+    ] if-empty ;
+
+: ?infimum ( seq/f -- elt/f )
+    [ f ] [
+        [ ] [ 2dup and [ min ] [ dupd ? ] if ] map-reduce
+    ] if-empty ;
+
 : change-last ( seq quot -- )
     [ drop length 1 - ] [ change-nth ] 2bi ; inline