Mercurial > lasercutter

annotate src/clojure/contrib/generic/comparison.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ;; Generic interfaces for comparison operations
rlm@10 2
rlm@10 3 ;; by Konrad Hinsen
rlm@10 4 ;; last updated May 25, 2010
rlm@10 5
rlm@10 6 ;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved. The use
rlm@10 7 ;; and distribution terms for this software are covered by the Eclipse
rlm@10 8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10 9 ;; which can be found in the file epl-v10.html at the root of this
rlm@10 10 ;; distribution. By using this software in any fashion, you are
rlm@10 11 ;; agreeing to be bound by the terms of this license. You must not
rlm@10 12 ;; remove this notice, or any other, from this software.
rlm@10 13
rlm@10 14 (ns
rlm@10 15 ^{:author "Konrad Hinsen"
rlm@10 16 :doc "Generic comparison interface
rlm@10 17 This library defines generic versions of = < > <= >= zero?
rlm@10 18 as multimethods that can be defined for any type. Of the
rlm@10 19 greater/less-than relations, types must minimally implement >."}
rlm@10 20 clojure.contrib.generic.comparison
rlm@10 21 (:refer-clojure :exclude [= < > <= >= zero? pos? neg? min max])
rlm@10 22 (:use [clojure.contrib.generic
rlm@10 23 :only (root-type nulary-type nary-type nary-dispatch)]))
rlm@10 24
rlm@10 25 ;
rlm@10 26 ; zero? pos? neg?
rlm@10 27 ;
rlm@10 28 (defmulti zero?
rlm@10 29 "Return true of x is zero."
rlm@10 30 {:arglists '([x])}
rlm@10 31 type)
rlm@10 32
rlm@10 33 (defmulti pos?
rlm@10 34 "Return true of x is positive."
rlm@10 35 {:arglists '([x])}
rlm@10 36 type)
rlm@10 37
rlm@10 38 (defmulti neg?
rlm@10 39 "Return true of x is negative."
rlm@10 40 {:arglists '([x])}
rlm@10 41 type)
rlm@10 42
rlm@10 43 ;
rlm@10 44 ; Equality
rlm@10 45 ;
rlm@10 46 (defmulti =
rlm@10 47 "Return true if all arguments are equal. The minimal implementation for type
rlm@10 48 ::my-type is the binary form with dispatch value [::my-type ::my-type]."
rlm@10 49 {:arglists '([x] [x y] [x y & more])}
rlm@10 50 nary-dispatch)
rlm@10 51
rlm@10 52 (defmethod = root-type
rlm@10 53 [x] true)
rlm@10 54
rlm@10 55 (defmethod = nary-type
rlm@10 56 [x y & more]
rlm@10 57 (if (= x y)
rlm@10 58 (if (next more)
rlm@10 59 (recur y (first more) (next more))
rlm@10 60 (= y (first more)))
rlm@10 61 false))
rlm@10 62
rlm@10 63 ;
rlm@10 64 ; Greater-than
rlm@10 65 ;
rlm@10 66 (defmulti >
rlm@10 67 "Return true if each argument is larger than the following ones.
rlm@10 68 The minimal implementation for type ::my-type is the binary form
rlm@10 69 with dispatch value [::my-type ::my-type]."
rlm@10 70 {:arglists '([x] [x y] [x y & more])}
rlm@10 71 nary-dispatch)
rlm@10 72
rlm@10 73 (defmethod > root-type
rlm@10 74 [x] true)
rlm@10 75
rlm@10 76 (defmethod > nary-type
rlm@10 77 [x y & more]
rlm@10 78 (if (> x y)
rlm@10 79 (if (next more)
rlm@10 80 (recur y (first more) (next more))
rlm@10 81 (> y (first more)))
rlm@10 82 false))
rlm@10 83
rlm@10 84 ;
rlm@10 85 ; Less-than defaults to greater-than with arguments inversed
rlm@10 86 ;
rlm@10 87 (defmulti <
rlm@10 88 "Return true if each argument is smaller than the following ones.
rlm@10 89 The minimal implementation for type ::my-type is the binary form
rlm@10 90 with dispatch value [::my-type ::my-type]. A default implementation
rlm@10 91 is provided in terms of >."
rlm@10 92 {:arglists '([x] [x y] [x y & more])}
rlm@10 93 nary-dispatch)
rlm@10 94
rlm@10 95 (defmethod < root-type
rlm@10 96 [x] true)
rlm@10 97
rlm@10 98 (defmethod < [root-type root-type]
rlm@10 99 [x y]
rlm@10 100 (> y x))
rlm@10 101
rlm@10 102 (defmethod < nary-type
rlm@10 103 [x y & more]
rlm@10 104 (if (< x y)
rlm@10 105 (if (next more)
rlm@10 106 (recur y (first more) (next more))
rlm@10 107 (< y (first more)))
rlm@10 108 false))
rlm@10 109
rlm@10 110 ;
rlm@10 111 ; Greater-or-equal defaults to (complement <)
rlm@10 112 ;
rlm@10 113 (defmulti >=
rlm@10 114 "Return true if each argument is larger than or equal to the following
rlm@10 115 ones. The minimal implementation for type ::my-type is the binary form
rlm@10 116 with dispatch value [::my-type ::my-type]. A default implementation
rlm@10 117 is provided in terms of <."
rlm@10 118 {:arglists '([x] [x y] [x y & more])}
rlm@10 119 nary-dispatch)
rlm@10 120
rlm@10 121 (defmethod >= root-type
rlm@10 122 [x] true)
rlm@10 123
rlm@10 124 (defmethod >= [root-type root-type]
rlm@10 125 [x y]
rlm@10 126 (not (< x y)))
rlm@10 127
rlm@10 128 (defmethod >= nary-type
rlm@10 129 [x y & more]
rlm@10 130 (if (>= x y)
rlm@10 131 (if (next more)
rlm@10 132 (recur y (first more) (next more))
rlm@10 133 (>= y (first more)))
rlm@10 134 false))
rlm@10 135
rlm@10 136 ;
rlm@10 137 ; Less-than defaults to (complement >)
rlm@10 138 ;
rlm@10 139 (defmulti <=
rlm@10 140 "Return true if each arguments is smaller than or equal to the following
rlm@10 141 ones. The minimal implementation for type ::my-type is the binary form
rlm@10 142 with dispatch value [::my-type ::my-type]. A default implementation
rlm@10 143 is provided in terms of >."
rlm@10 144 {:arglists '([x] [x y] [x y & more])}
rlm@10 145 nary-dispatch)
rlm@10 146
rlm@10 147 (defmethod <= root-type
rlm@10 148 [x] true)
rlm@10 149
rlm@10 150 (defmethod <= [root-type root-type]
rlm@10 151 [x y]
rlm@10 152 (not (> x y)))
rlm@10 153
rlm@10 154 (defmethod <= nary-type
rlm@10 155 [x y & more]
rlm@10 156 (if (<= x y)
rlm@10 157 (if (next more)
rlm@10 158 (recur y (first more) (next more))
rlm@10 159 (<= y (first more)))
rlm@10 160 false))
rlm@10 161
rlm@10 162 ;
rlm@10 163 ; Implementations for Clojure's built-in types
rlm@10 164 ;
rlm@10 165 (defmethod zero? java.lang.Number
rlm@10 166 [x]
rlm@10 167 (clojure.core/zero? x))
rlm@10 168
rlm@10 169 (defmethod pos? java.lang.Number
rlm@10 170 [x]
rlm@10 171 (clojure.core/pos? x))
rlm@10 172
rlm@10 173 (defmethod neg? java.lang.Number
rlm@10 174 [x]
rlm@10 175 (clojure.core/neg? x))
rlm@10 176
rlm@10 177 (defmethod = [Object Object]
rlm@10 178 [x y]
rlm@10 179 (clojure.core/= x y))
rlm@10 180
rlm@10 181 (defmethod > [java.lang.Number java.lang.Number]
rlm@10 182 [x y]
rlm@10 183 (clojure.core/> x y))
rlm@10 184
rlm@10 185 (defmethod < [java.lang.Number java.lang.Number]
rlm@10 186 [x y]
rlm@10 187 (clojure.core/< x y))
rlm@10 188
rlm@10 189 (defmethod >= [java.lang.Number java.lang.Number]
rlm@10 190 [x y]
rlm@10 191 (clojure.core/>= x y))
rlm@10 192
rlm@10 193 (defmethod <= [java.lang.Number java.lang.Number]
rlm@10 194 [x y]
rlm@10 195 (clojure.core/<= x y))
rlm@10 196
rlm@10 197 ;
rlm@10 198 ; Functions defined in terms of the comparison operators
rlm@10 199 ;
rlm@10 200 (defn max
rlm@10 201 "Returns the greatest of its arguments. Like clojure.core/max except that
rlm@10 202 is uses generic comparison functions implementable for any data type."
rlm@10 203 ([x] x)
rlm@10 204 ([x y] (if (> x y) x y))
rlm@10 205 ([x y & more]
rlm@10 206 (reduce max (max x y) more)))
rlm@10 207
rlm@10 208 (defn min
rlm@10 209 "Returns the least of its arguments. Like clojure.core/min except that
rlm@10 210 is uses generic comparison functions implementable for any data type."
rlm@10 211 ([x] x)
rlm@10 212 ([x y] (if (< x y) x y))
rlm@10 213 ([x y & more]
rlm@10 214 (reduce min (min x y) more)))