Mercurial > lasercutter

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