generic: modified arithmetic and added math-functions

4 files changed, 110 insertions, 22 deletions

diff --git a/src/clojure/contrib/gen_html_docs.clj b/src/clojure/contrib/gen_html_docs.clj
index 7cf62d9e..7a587fdf 100644
--- a/src/clojure/contrib/gen_html_docs.clj
+++ b/src/clojure/contrib/gen_html_docs.clj
@@ -483,6 +483,7 @@ emits the generated HTML to the path named by path."
      'clojure.contrib.except
      'clojure.contrib.fcase
      'clojure.contrib.generic.arithmetic
+     'clojure.contrib.generic.math-functions
      'clojure.contrib.import-static
      'clojure.contrib.javadoc
      'clojure.contrib.javalog
diff --git a/src/clojure/contrib/generic/arithmetic.clj b/src/clojure/contrib/generic/arithmetic.clj
index 558ec37b..98d5cfef 100644
--- a/src/clojure/contrib/generic/arithmetic.clj
+++ b/src/clojure/contrib/generic/arithmetic.clj
@@ -1,7 +1,7 @@
 ;; Generic interfaces for arithmetic operations
 
 ;; by Konrad Hinsen
-;; last updated March 12, 2009
+;; last updated March 13, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -21,7 +21,8 @@
    that can be defined for any type. The minimal required implementations
    for a type are binary + and * plus unary - and /. Everything else
    is derived from these automatically. Explicit binary definitions
-   for - and / can be given for efficiency reasons."
+   for - and / can be provided for efficiency reasons."
+  (:use [clojure.contrib.types :only (defadt)])
   (:refer-clojure :exclude [+ - * /]))
 
 ;
@@ -31,26 +32,26 @@
 ;
 (defn- nary-dispatch
   ([] ::nulary)
-  ([x] [::unary (type x)])
+  ([x] (type x))
   ([x y]
-     (let [tx (type x)
-	   ty (type y)]
-       (cond (isa? tx ty) [::binary ty]
-	     (isa? ty tx) [::binary tx]
-	     ; Should there be clause checking if tx and ty have
-	     ; a common ancestor? This would cover cases like
-	     ; java.lang.Integer and java.lang.Double, which have the
-	     ; common ancestor java.lang.Number.
-	     :else [::binary tx ty])))
+     [(type x) (type y)])
   ([x y & more] ::n-ary))
 
 ;
+; Universal zero and one values
+;
+(defadt ::zero zero)
+(defadt ::one one)
+
+;
 ; 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.
 ;
 (derive Object ::any)
+(derive ::zero ::any)
+(derive ::one ::any)
 
 ;
 ; Addition
@@ -63,11 +64,17 @@
 
 (defmethod + ::nulary
   []
-  ::zero)
+  zero)
 
-(defmethod + [::unary ::any]
+(defmethod + ::any
   [x] x)
 
+(defmethod + [::any ::zero]
+  [x y] x)
+
+(defmethod + [::zero ::any]
+  [x y] y)
+
 (defmethod + ::n-ary
   [x y & more]
   (if more
@@ -88,7 +95,13 @@
   (throw (java.lang.IllegalArgumentException.
 	  "Wrong number of arguments passed")))
 
-(defmethod - [::binary ::any]
+(defmethod - [::any ::zero]
+  [x y] x)
+
+(defmethod - [::zero ::any]
+  [x y] (- y))
+
+(defmethod - [::any ::any]
   [x y] (+ x (- y)))
 
 (defmethod - ::n-ary
@@ -108,11 +121,17 @@
 
 (defmethod * ::nulary
   []
-  ::one)
+  one)
 
-(defmethod * [::unary ::any]
+(defmethod * ::any
   [x] x)
 
+(defmethod * [::any ::one]
+  [x y] x)
+
+(defmethod * [::one ::any]
+  [x y] y)
+
 (defmethod * ::n-ary
   [x y & more]
   (if more
@@ -133,7 +152,13 @@
   (throw (java.lang.IllegalArgumentException.
 	  "Wrong number of arguments passed")))
 
-(defmethod / [::binary ::any]
+(defmethod / [::any ::one]
+  [x y] x)
+
+(defmethod / [::one ::any]
+  [x y] (/ y))
+
+(defmethod / [::any ::any]
   [x y] (* x (/ y)))
 
 (defmethod / ::n-ary
@@ -145,15 +170,15 @@
 ;
 ; Minimal implementations for java.lang.Number
 ;
-(defmethod + [::binary java.lang.Number]
+(defmethod + [java.lang.Number java.lang.Number]
   [x y] (clojure.core/+ x y))
 
-(defmethod - [::unary java.lang.Number]
+(defmethod - java.lang.Number
   [x] (clojure.core/- x))
 
-(defmethod * [::binary java.lang.Number]
+(defmethod * [java.lang.Number java.lang.Number]
   [x y] (clojure.core/* x y))
 
-(defmethod / [::unary java.lang.Number]
+(defmethod / java.lang.Number
   [x] (clojure.core// x))
 
diff --git a/src/clojure/contrib/generic/math_functions.clj b/src/clojure/contrib/generic/math_functions.clj
new file mode 100644
index 00000000..d2d1fe97
--- /dev/null
+++ b/src/clojure/contrib/generic/math_functions.clj
@@ -0,0 +1,61 @@
+;; Generic interfaces for mathematical functions
+
+;; by Konrad Hinsen
+;; last updated March 13, 2009
+
+;; Copyright (c) Konrad Hinsen, 2009. 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.contrib.generic.math-functions
+  "Generic math function interface
+
+   NOTE: This library is VERY experimental. It WILL change significantly
+   with future release.
+
+   This library defines generic versions of common mathematical functions
+   such as sqrt or sin as multimethods that can be defined for any type."
+  (:use [clojure.contrib.def :only (defmacro-)]))
+
+(defmacro- defmathfn-1
+  [name]
+  (let [java-symbol (symbol "java.lang.Math" (str name))]
+    `(do
+       (defmulti ~name type)
+       (defmethod ~name java.lang.Number
+	 [~'x]
+	 (~java-symbol ~'x)))))
+
+(defn- two-types [x y] [(type x) (type y)])
+
+(defmacro- defmathfn-2
+  [name]
+  (let [java-symbol (symbol "java.lang.Math" (str name))]
+    `(do
+       (defmulti ~name two-types)
+       (defmethod ~name [java.lang.Number java.lang.Number]
+	 [~'x ~'y]
+	 (~java-symbol ~'x ~'y)))))
+
+; List of math functions taken from
+; http://java.sun.com/j2se/1.4.2/docs/api/java/lang/Math.html
+(defmathfn-1 abs)
+(defmathfn-1 acos)
+(defmathfn-1 asin)
+(defmathfn-1 atan)
+(defmathfn-2 atan2)
+(defmathfn-1 ceil)
+(defmathfn-1 cos)
+(defmathfn-1 exp)
+(defmathfn-1 floor)
+(defmathfn-1 log)
+(defmathfn-2 pow)
+(defmathfn-1 rint)
+(defmathfn-1 round)
+(defmathfn-1 sin)
+(defmathfn-1 sqrt)
+(defmathfn-1 tan)
diff --git a/src/clojure/contrib/load_all.clj b/src/clojure/contrib/load_all.clj
index f2b77bac..9593e2ce 100644
--- a/src/clojure/contrib/load_all.clj
+++ b/src/clojure/contrib/load_all.clj
@@ -43,6 +43,7 @@ error-kit
 except
 fcase
 generic.arithmetic
+generic.math-functions
 import-static
 javadoc.browse
 javadoc