sequences.extras: add ?supremum and ?infimum

modern-harvey2
Alexander Iljin 2017-06-22 13:32:46 +03:00 committed by John Benediktsson
parent f87d017624
commit fff7bc72a4
3 changed files with 46 additions and 0 deletions

View File

@ -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 }

View File

@ -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

View File

@ -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