Permalink
Browse files

algo.generic.comparison migrated from old contrib

  • Loading branch information...
khinsen committed Sep 5, 2011
1 parent b6fe0d8 commit 42a5100eb194c857f3f8f3f8265195c9a730c8de
View
27 pom.xml
@@ -0,0 +1,27 @@
+<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
+ <modelVersion>4.0.0</modelVersion>
+ <artifactId>algo.generic</artifactId>
+ <version>0.1.0-SNAPSHOT</version>
+ <name>${artifactId}</name>
+
+ <parent>
+ <groupId>org.clojure</groupId>
+ <artifactId>pom.contrib</artifactId>
+ <version>0.0.20</version>
+ </parent>
+
+ <developers>
+ <developer>
+ <name>Konrad Hinsen</name>
+ </developer>
+ </developers>
+
+ <dependencies>
+ </dependencies>
+
+ <scm>
+ <connection>scm:git:git@github.com:clojure/algo.generic.git</connection>
+ <developerConnection>scm:git:git@github.com:clojure/algo.generic.git</developerConnection>
+ <url>git@github.com:clojure/algo.generic.git</url>
+ </scm>
+</project>
@@ -0,0 +1,52 @@
+;; Support code for generic interfaces
+
+;; by Konrad Hinsen
+
+;; Copyright (c) Konrad Hinsen, 2009-2011. All rights reserved. The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this
+;; distribution. By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license. You must not
+;; remove this notice, or any other, from this software.
+
+(ns
+ ^{:author "Konrad Hinsen"
+ :skip-wiki true
+ :doc "Generic interfaces
+ This library provides generic interfaces in the form of
+ multimethods that can be implemented for any type.
+ The interfaces partly duplicate existing non-generic
+ functions in clojure.core (arithmetic, comparison,
+ collections) and partly provide additional functions that
+ can be defined for a wide variety of types (functors, math
+ functions)."}
+ clojure.algo.generic)
+
+;
+; A dispatch function that separates nulary, unary, binary, and
+; higher arity calls and also selects on type for unary and binary
+; calls.
+;
+(defn nary-dispatch
+ ([] ::nulary)
+ ([x] (type x))
+ ([x y]
+ [(type x) (type y)])
+ ([x y & more] ::nary))
+
+;
+; We can't use [::binary :default], so we need to define a root type
+; of the type hierarcy. The derivation for Object covers all classes,
+; but all non-class types will need an explicit derive clause.
+; Ultimately, a macro might take care of this.
+;
+(def root-type ::any)
+(derive Object root-type)
+
+;
+; Symbols referring to ::nulary and ::n-ary
+;
+(def nulary-type ::nulary)
+(def nary-type ::nary)
+
@@ -0,0 +1,218 @@
+;; Generic interfaces for comparison operations
+
+;; by Konrad Hinsen
+
+;; Copyright (c) Konrad Hinsen, 2009-2011. All rights reserved. The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this
+;; distribution. By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license. You must not
+;; remove this notice, or any other, from this software.
+
+(ns
+ ^{:author "Konrad Hinsen"
+ :doc "Generic comparison interface
+ This library defines generic versions of = not= < > <= >= zero?
+ as multimethods that can be defined for any type. Of the
+ greater/less-than relations, types must minimally implement >."}
+ clojure.algo.generic.comparison
+ (:refer-clojure :exclude [= not= < > <= >= zero? pos? neg? min max])
+ (:use [clojure.algo.generic
+ :only (root-type nulary-type nary-type nary-dispatch)]))
+
+;
+; zero? pos? neg?
+;
+(defmulti zero?
+ "Return true of x is zero."
+ {:arglists '([x])}
+ type)
+
+(defmulti pos?
+ "Return true of x is positive."
+ {:arglists '([x])}
+ type)
+
+(defmulti neg?
+ "Return true of x is negative."
+ {:arglists '([x])}
+ type)
+
+;
+; Equality
+;
+(defmulti =
+ "Return true if all arguments are equal. The minimal implementation for type
+ ::my-type is the binary form with dispatch value [::my-type ::my-type]."
+ {:arglists '([x] [x y] [x y & more])}
+ nary-dispatch)
+
+(defmethod = root-type
+ [x] true)
+
+(defmethod = nary-type
+ [x y & more]
+ (if (= x y)
+ (if (next more)
+ (recur y (first more) (next more))
+ (= y (first more)))
+ false))
+
+(defn not=
+ "Equivalent to (not (= ...))."
+ [& args]
+ (not (apply = args)))
+
+;
+; Greater-than
+;
+(defmulti >
+ "Return true if each argument is larger than the following ones.
+ The minimal implementation for type ::my-type is the binary form
+ with dispatch value [::my-type ::my-type]."
+ {:arglists '([x] [x y] [x y & more])}
+ nary-dispatch)
+
+(defmethod > root-type
+ [x] true)
+
+(defmethod > nary-type
+ [x y & more]
+ (if (> x y)
+ (if (next more)
+ (recur y (first more) (next more))
+ (> y (first more)))
+ false))
+
+;
+; Less-than defaults to greater-than with arguments inversed
+;
+(defmulti <
+ "Return true if each argument is smaller than the following ones.
+ The minimal implementation for type ::my-type is the binary form
+ with dispatch value [::my-type ::my-type]. A default implementation
+ is provided in terms of >."
+ {:arglists '([x] [x y] [x y & more])}
+ nary-dispatch)
+
+(defmethod < root-type
+ [x] true)
+
+(defmethod < [root-type root-type]
+ [x y]
+ (> y x))
+
+(defmethod < nary-type
+ [x y & more]
+ (if (< x y)
+ (if (next more)
+ (recur y (first more) (next more))
+ (< y (first more)))
+ false))
+
+;
+; Greater-or-equal defaults to (complement <)
+;
+(defmulti >=
+ "Return true if each argument is larger than or equal to the following
+ ones. The minimal implementation for type ::my-type is the binary form
+ with dispatch value [::my-type ::my-type]. A default implementation
+ is provided in terms of <."
+ {:arglists '([x] [x y] [x y & more])}
+ nary-dispatch)
+
+(defmethod >= root-type
+ [x] true)
+
+(defmethod >= [root-type root-type]
+ [x y]
+ (not (< x y)))
+
+(defmethod >= nary-type
+ [x y & more]
+ (if (>= x y)
+ (if (next more)
+ (recur y (first more) (next more))
+ (>= y (first more)))
+ false))
+
+;
+; Less-than defaults to (complement >)
+;
+(defmulti <=
+ "Return true if each arguments is smaller than or equal to the following
+ ones. The minimal implementation for type ::my-type is the binary form
+ with dispatch value [::my-type ::my-type]. A default implementation
+ is provided in terms of >."
+ {:arglists '([x] [x y] [x y & more])}
+ nary-dispatch)
+
+(defmethod <= root-type
+ [x] true)
+
+(defmethod <= [root-type root-type]
+ [x y]
+ (not (> x y)))
+
+(defmethod <= nary-type
+ [x y & more]
+ (if (<= x y)
+ (if (next more)
+ (recur y (first more) (next more))
+ (<= y (first more)))
+ false))
+
+;
+; Implementations for Clojure's built-in types
+;
+(defmethod zero? java.lang.Number
+ [x]
+ (clojure.core/zero? x))
+
+(defmethod pos? java.lang.Number
+ [x]
+ (clojure.core/pos? x))
+
+(defmethod neg? java.lang.Number
+ [x]
+ (clojure.core/neg? x))
+
+(defmethod = [Object Object]
+ [x y]
+ (clojure.core/= x y))
+
+(defmethod > [java.lang.Number java.lang.Number]
+ [x y]
+ (clojure.core/> x y))
+
+(defmethod < [java.lang.Number java.lang.Number]
+ [x y]
+ (clojure.core/< x y))
+
+(defmethod >= [java.lang.Number java.lang.Number]
+ [x y]
+ (clojure.core/>= x y))
+
+(defmethod <= [java.lang.Number java.lang.Number]
+ [x y]
+ (clojure.core/<= x y))
+
+;
+; Functions defined in terms of the comparison operators
+;
+(defn max
+ "Returns the greatest of its arguments. Like clojure.core/max except that
+ is uses generic comparison functions implementable for any data type."
+ ([x] x)
+ ([x y] (if (> x y) x y))
+ ([x y & more]
+ (reduce max (max x y) more)))
+
+(defn min
+ "Returns the least of its arguments. Like clojure.core/min except that
+ is uses generic comparison functions implementable for any data type."
+ ([x] x)
+ ([x y] (if (< x y) x y))
+ ([x y & more]
+ (reduce min (min x y) more)))
@@ -0,0 +1,46 @@
+;; Test routines for clojure.algo.generic.comparison
+
+;; Copyright (c) Konrad Hinsen, 2011. All rights reserved. The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this
+;; distribution. By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license. You must not
+;; remove this notice, or any other, from this software.
+
+(ns clojure.algo.generic.test-comparison
+ (:use [clojure.test :only (deftest is are run-tests)]
+ [clojure.algo.generic :only (root-type)])
+ (:require [clojure.algo.generic.comparison :as gc]))
+
+; Define a class that wraps a number.
+(defrecord my-number [value])
+(defn n [value] (new my-number value))
+
+(derive my-number root-type)
+
+; Implement the minimal comparison multimethods.
+(defmethod gc/zero? my-number
+ [x]
+ (zero? (:value x)))
+
+(defmethod gc/= [my-number my-number]
+ [x y]
+ (= (:value x) (:value y)))
+
+(defmethod gc/> [my-number my-number]
+ [x y]
+ (> (:value x) (:value y)))
+
+; Basic tests
+(deftest number-comparison
+ (is (gc/zero? (n 0)))
+ (is (not (gc/zero? (n 1))))
+ (is (gc/= (n 2) (n 2)))
+ (is (gc/not= (n 2) (n 3)))
+ (is (gc/> (n 3) (n 2)))
+ (is (gc/>= (n 3) (n 2)))
+ (is (gc/< (n 2) (n 3)))
+ (is (gc/<= (n 2) (n 3)))
+ (is (gc/>= (n 2) (n 2)))
+ (is (gc/<= (n 2) (n 2))))

0 comments on commit 42a5100

Please sign in to comment.