diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor new file mode 100644 index 0000000000..029d41efa8 --- /dev/null +++ b/core/math/order/order-docs.factor @@ -0,0 +1,63 @@ +USING: help.markup help.syntax kernel math sequences quotations +math.private ; +IN: math.order + +HELP: <=> +{ $values { "obj1" object } { "obj2" object } { "n" real } } +{ $contract + "Compares two objects using an intrinsic total order, for example, the natural order for real numbers and lexicographic order for strings." + $nl + "The output value is one of the following:" + { $list + { "positive - indicating that " { $snippet "obj1" } " follows " { $snippet "obj2" } } + { "zero - indicating that " { $snippet "obj1" } " is equal to " { $snippet "obj2" } } + { "negative - indicating that " { $snippet "obj1" } " precedes " { $snippet "obj2" } } + } + "The default implementation treats the two objects as sequences, and recursively compares their elements. So no extra work is required to compare sequences lexicographically." +} ; + +HELP: compare +{ $values { "obj1" object } { "obj2" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "n" integer } } +{ $description "Compares the results of applying the quotation to both objects via " { $link <=> } "." } +{ $examples { $example "USING: kernel math.order prettyprint sequences ;" "\"hello\" \"hi\" [ length ] compare ." "3" } +} ; + +HELP: max +{ $values { "x" real } { "y" real } { "z" real } } +{ $description "Outputs the greatest of two real numbers." } ; + +HELP: min +{ $values { "x" real } { "y" real } { "z" real } } +{ $description "Outputs the smallest of two real numbers." } ; + +HELP: between? +{ $values { "x" real } { "y" real } { "z" real } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." } +{ $notes "As per the closed interval notation, the end-points are included in the interval." } ; + +HELP: before? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes before " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +HELP: after? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes after " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +HELP: before=? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes before or equals " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +HELP: after=? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes after or equals " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +{ before? after? before=? after=? } related-words + +HELP: [-] +{ $values { "x" real } { "y" real } { "z" real } } +{ $description "Subtracts " { $snippet "y" } " from " { $snippet "x" } ". If the result is less than zero, outputs zero." } ; + diff --git a/core/math/order/order-tests.factor b/core/math/order/order-tests.factor new file mode 100644 index 0000000000..6dbaf29e7c --- /dev/null +++ b/core/math/order/order-tests.factor @@ -0,0 +1,6 @@ +USING: kernel math.order tools.test ; +IN: math.order.tests + +[ -1 ] [ "ab" "abc" <=> ] unit-test +[ 1 ] [ "abc" "ab" <=> ] unit-test + diff --git a/core/math/order/order.factor b/core/math/order/order.factor new file mode 100644 index 0000000000..eb781d1967 --- /dev/null +++ b/core/math/order/order.factor @@ -0,0 +1,34 @@ +! Copyright (C) 2008 Slava Pestov, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math ; +IN: math.order + +GENERIC: <=> ( obj1 obj2 -- n ) + +M: real <=> - ; +M: integer <=> - ; + +GENERIC: before? ( obj1 obj2 -- ? ) +GENERIC: after? ( obj1 obj2 -- ? ) +GENERIC: before=? ( obj1 obj2 -- ? ) +GENERIC: after=? ( obj1 obj2 -- ? ) + +M: object before? ( obj1 obj2 -- ? ) <=> 0 < ; +M: object after? ( obj1 obj2 -- ? ) <=> 0 > ; +M: object before=? ( obj1 obj2 -- ? ) <=> 0 <= ; +M: object after=? ( obj1 obj2 -- ? ) <=> 0 >= ; + +M: real before? ( obj1 obj2 -- ? ) < ; +M: real after? ( obj1 obj2 -- ? ) > ; +M: real before=? ( obj1 obj2 -- ? ) <= ; +M: real after=? ( obj1 obj2 -- ? ) >= ; + +: min ( x y -- z ) [ before? ] most ; inline +: max ( x y -- z ) [ after? ] most ; inline + +: between? ( x y z -- ? ) + pick after=? [ after=? ] [ 2drop f ] if ; inline + +: [-] ( x y -- z ) - 0 max ; inline + +: compare ( obj1 obj2 quot -- n ) bi@ <=> ; inline