rlm@10: ;; Generic interfaces for comparison operations
rlm@10: 
rlm@10: ;; by Konrad Hinsen
rlm@10: ;; last updated May 25, 2010
rlm@10: 
rlm@10: ;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved.  The use
rlm@10: ;; and distribution terms for this software are covered by the Eclipse
rlm@10: ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10: ;; which can be found in the file epl-v10.html at the root of this
rlm@10: ;; distribution.  By using this software in any fashion, you are
rlm@10: ;; agreeing to be bound by the terms of this license.  You must not
rlm@10: ;; remove this notice, or any other, from this software.
rlm@10: 
rlm@10: (ns
rlm@10:   ^{:author "Konrad Hinsen"
rlm@10:      :doc "Generic comparison interface
rlm@10:            This library defines generic versions of = < > <= >= zero?
rlm@10:            as multimethods that can be defined for any type. Of the
rlm@10:            greater/less-than relations, types must minimally implement >."}
rlm@10:   clojure.contrib.generic.comparison
rlm@10:   (:refer-clojure :exclude [= < > <= >= zero? pos? neg? min max])
rlm@10:   (:use [clojure.contrib.generic
rlm@10: 	 :only (root-type nulary-type nary-type nary-dispatch)]))
rlm@10: 
rlm@10: ;
rlm@10: ; zero? pos? neg?
rlm@10: ;
rlm@10: (defmulti zero?
rlm@10:   "Return true of x is zero."
rlm@10:   {:arglists '([x])}
rlm@10:   type)
rlm@10: 
rlm@10: (defmulti pos?
rlm@10:   "Return true of x is positive."
rlm@10:   {:arglists '([x])}
rlm@10:   type)
rlm@10: 
rlm@10: (defmulti neg?
rlm@10:   "Return true of x is negative."
rlm@10:   {:arglists '([x])}
rlm@10:   type)
rlm@10: 
rlm@10: ;
rlm@10: ; Equality
rlm@10: ;
rlm@10: (defmulti =
rlm@10:   "Return true if all arguments are equal. The minimal implementation for type
rlm@10:    ::my-type is the binary form with dispatch value [::my-type ::my-type]."
rlm@10:   {:arglists '([x] [x y] [x y & more])}
rlm@10:   nary-dispatch)
rlm@10: 
rlm@10: (defmethod = root-type
rlm@10:   [x] true)
rlm@10: 
rlm@10: (defmethod = nary-type
rlm@10:   [x y & more]
rlm@10:   (if (= x y)
rlm@10:     (if (next more)
rlm@10:       (recur y (first more) (next more))
rlm@10:       (= y (first more)))
rlm@10:     false))
rlm@10: 
rlm@10: ;
rlm@10: ; Greater-than
rlm@10: ;
rlm@10: (defmulti >
rlm@10:   "Return true if each argument is larger than the following ones.
rlm@10:    The minimal implementation for type ::my-type is the binary form
rlm@10:    with dispatch value [::my-type ::my-type]."
rlm@10:   {:arglists '([x] [x y] [x y & more])}
rlm@10:   nary-dispatch)
rlm@10: 
rlm@10: (defmethod > root-type
rlm@10:   [x] true)
rlm@10: 
rlm@10: (defmethod > nary-type
rlm@10:   [x y & more]
rlm@10:   (if (> x y)
rlm@10:     (if (next more)
rlm@10:       (recur y (first more) (next more))
rlm@10:       (> y (first more)))
rlm@10:     false))
rlm@10: 
rlm@10: ;
rlm@10: ; Less-than defaults to greater-than with arguments inversed
rlm@10: ;
rlm@10: (defmulti <
rlm@10:   "Return true if each argument is smaller than the following ones.
rlm@10:    The minimal implementation for type ::my-type is the binary form
rlm@10:    with dispatch value [::my-type ::my-type]. A default implementation
rlm@10:    is provided in terms of >."
rlm@10:   {:arglists '([x] [x y] [x y & more])}
rlm@10:   nary-dispatch)
rlm@10: 
rlm@10: (defmethod < root-type
rlm@10:   [x] true)
rlm@10: 
rlm@10: (defmethod < [root-type root-type]
rlm@10:   [x y]
rlm@10:   (> y x))
rlm@10: 
rlm@10: (defmethod < nary-type
rlm@10:   [x y & more]
rlm@10:   (if (< x y)
rlm@10:     (if (next more)
rlm@10:       (recur y (first more) (next more))
rlm@10:       (< y (first more)))
rlm@10:     false))
rlm@10: 
rlm@10: ;
rlm@10: ; Greater-or-equal defaults to (complement <)
rlm@10: ;
rlm@10: (defmulti >=
rlm@10:   "Return true if each argument is larger than or equal to the following
rlm@10:    ones. The minimal implementation for type ::my-type is the binary form
rlm@10:    with dispatch value [::my-type ::my-type]. A default implementation
rlm@10:    is provided in terms of <."
rlm@10:   {:arglists '([x] [x y] [x y & more])}
rlm@10:   nary-dispatch)
rlm@10: 
rlm@10: (defmethod >= root-type
rlm@10:   [x] true)
rlm@10: 
rlm@10: (defmethod >= [root-type root-type]
rlm@10:   [x y]
rlm@10:   (not (< x y)))
rlm@10: 
rlm@10: (defmethod >= nary-type
rlm@10:   [x y & more]
rlm@10:   (if (>= x y)
rlm@10:     (if (next more)
rlm@10:       (recur y (first more) (next more))
rlm@10:       (>= y (first more)))
rlm@10:     false))
rlm@10: 
rlm@10: ;
rlm@10: ; Less-than defaults to (complement >)
rlm@10: ;
rlm@10: (defmulti <=
rlm@10:   "Return true if each arguments is smaller than or equal to the following
rlm@10:    ones. The minimal implementation for type ::my-type is the binary form
rlm@10:    with dispatch value [::my-type ::my-type]. A default implementation
rlm@10:    is provided in terms of >."
rlm@10:   {:arglists '([x] [x y] [x y & more])}
rlm@10:   nary-dispatch)
rlm@10: 
rlm@10: (defmethod <= root-type
rlm@10:   [x] true)
rlm@10: 
rlm@10: (defmethod <= [root-type root-type]
rlm@10:   [x y]
rlm@10:   (not (> x y)))
rlm@10: 
rlm@10: (defmethod <= nary-type
rlm@10:   [x y & more]
rlm@10:   (if (<= x y)
rlm@10:     (if (next more)
rlm@10:       (recur y (first more) (next more))
rlm@10:       (<= y (first more)))
rlm@10:     false))
rlm@10: 
rlm@10: ;
rlm@10: ; Implementations for Clojure's built-in types
rlm@10: ;
rlm@10: (defmethod zero? java.lang.Number
rlm@10:   [x]
rlm@10:   (clojure.core/zero? x))
rlm@10: 
rlm@10: (defmethod pos? java.lang.Number
rlm@10:   [x]
rlm@10:   (clojure.core/pos? x))
rlm@10: 
rlm@10: (defmethod neg? java.lang.Number
rlm@10:   [x]
rlm@10:   (clojure.core/neg? x))
rlm@10: 
rlm@10: (defmethod = [Object Object]
rlm@10:   [x y]
rlm@10:   (clojure.core/= x y))
rlm@10: 
rlm@10: (defmethod > [java.lang.Number java.lang.Number]
rlm@10:   [x y]
rlm@10:   (clojure.core/> x y))
rlm@10: 
rlm@10: (defmethod < [java.lang.Number java.lang.Number]
rlm@10:   [x y]
rlm@10:   (clojure.core/< x y))
rlm@10: 
rlm@10: (defmethod >= [java.lang.Number java.lang.Number]
rlm@10:   [x y]
rlm@10:   (clojure.core/>= x y))
rlm@10: 
rlm@10: (defmethod <= [java.lang.Number java.lang.Number]
rlm@10:   [x y]
rlm@10:   (clojure.core/<= x y))
rlm@10: 
rlm@10: ;
rlm@10: ; Functions defined in terms of the comparison operators
rlm@10: ;
rlm@10: (defn max
rlm@10:   "Returns the greatest of its arguments. Like clojure.core/max except that
rlm@10:    is uses generic comparison functions implementable for any data type."
rlm@10:   ([x] x)
rlm@10:   ([x y] (if (> x y) x y))
rlm@10:   ([x y & more]
rlm@10:    (reduce max (max x y) more)))
rlm@10: 
rlm@10: (defn min
rlm@10:   "Returns the least of its arguments. Like clojure.core/min except that
rlm@10:    is uses generic comparison functions implementable for any data type."
rlm@10:   ([x] x)
rlm@10:   ([x y] (if (< x y) x y))
rlm@10:   ([x y & more]
rlm@10:    (reduce min (min x y) more)))