complex-numbers: abs, conjugate, sqrt

4 files changed, 193 insertions, 8 deletions

diff --git a/src/clojure/contrib/complex_numbers.clj b/src/clojure/contrib/complex_numbers.clj
index 579aba10..1a05934a 100644
--- a/src/clojure/contrib/complex_numbers.clj
+++ b/src/clojure/contrib/complex_numbers.clj
@@ -1,7 +1,7 @@
 ;; Complex numbers
 
 ;; by Konrad Hinsen
-;; last updated March 19, 2009
+;; last updated March 23, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -222,3 +222,37 @@
 ; can be added later...
 ;
 
+;
+; Conjugation
+;
+(defmethod gm/conjugate ::complex
+  [x]
+  (let [[r i] (vals x)]
+    (complex r (ga/- i))))
+
+(defmethod gm/conjugate ::pure-imaginary
+  [x]
+  (imaginary (ga/- (imag x))))
+
+;
+; Absolute value
+;
+(defmethod gm/abs ::complex
+  [x]
+  (let [[r i] (vals x)]
+    (gm/sqrt (ga/+ (ga/* r r) (ga/* i i)))))
+
+(defmethod gm/abs ::pure-imaginary
+  [x]
+  (gm/abs (imag x)))
+
+;
+; Square root
+;
+(defmethod gm/sqrt ::complex
+  [{r :real i :imag}]
+  (let [abs (gm/sqrt (ga/+ (ga/* r r) (ga/* i i)))
+	p   (gm/sqrt ((ga/qsym ga /) (ga/+ abs r) 2))
+	q   (ga/* (gm/sgn i) 
+		  (gm/sqrt ((ga/qsym ga /) (ga/- abs r) 2)))]
+    (complex p q)))
diff --git a/src/clojure/contrib/generic/comparison.clj b/src/clojure/contrib/generic/comparison.clj
index 6bd34184..237a8e98 100644
--- a/src/clojure/contrib/generic/comparison.clj
+++ b/src/clojure/contrib/generic/comparison.clj
@@ -1,7 +1,7 @@
 ;; Generic interfaces for comparison operations
 
 ;; by Konrad Hinsen
-;; last updated March 19, 2009
+;; last updated March 23, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -18,7 +18,8 @@
    with future release.
 
    This library defines generic versions of = < > <= >= zero? as multimethods
-   that can be defined for any type."
+   that can be defined for any type. Of the greater/less-than relations,
+   types must minimally implement >."
   (:refer-clojure :exclude [= < > <= >= zero?])
   (:use [clojure.contrib.generic
 	 :only (root-type nulary-type nary-type nary-dispatch)]))
@@ -45,6 +46,82 @@
     false))
 
 ;
+; Greater-than
+;
+(defmulti > 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 < 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 >= 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 <= 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
@@ -54,3 +131,19 @@
 (defmethod = [Object Object]
   [x y]
   (clojure.core/= x y))
+
+(defmethod > [Object Object]
+  [x y]
+  (clojure.core/> x y))
+
+(defmethod < [Object Object]
+  [x y]
+  (clojure.core/< x y))
+
+(defmethod >= [Object Object]
+  [x y]
+  (clojure.core/>= x y))
+
+(defmethod <= [Object Object]
+  [x y]
+  (clojure.core/<= x y))
diff --git a/src/clojure/contrib/generic/math_functions.clj b/src/clojure/contrib/generic/math_functions.clj
index d2d1fe97..77623cce 100644
--- a/src/clojure/contrib/generic/math_functions.clj
+++ b/src/clojure/contrib/generic/math_functions.clj
@@ -1,7 +1,7 @@
 ;; Generic interfaces for mathematical functions
 
 ;; by Konrad Hinsen
-;; last updated March 13, 2009
+;; last updated March 23, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -19,7 +19,9 @@
 
    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-)]))
+  (:use [clojure.contrib.def :only (defmacro-)])
+  (:require [clojure.contrib.generic.arithmetic :as ga]
+	    [clojure.contrib.generic.comparison :as gc]))
 
 (defmacro- defmathfn-1
   [name]
@@ -59,3 +61,39 @@
 (defmathfn-1 sin)
 (defmathfn-1 sqrt)
 (defmathfn-1 tan)
+
+;
+; Sign
+;
+(defmulti sgn type)
+(defmethod sgn :default
+  [x]
+  (cond (gc/zero? x) 0
+	(gc/> x 0) 1
+	:else -1))
+
+;
+; Conjugation
+;
+(defmulti conjugate type)
+
+(defmethod conjugate :default
+  [x] x)
+
+;
+; Square
+;
+(defmulti sqr type)
+
+(defmethod sqr :default
+  [x]
+  (ga/* x x))
+
+;
+; Approximate equality for use with floating point types
+;
+(defn approx=
+  "Return true if the absolute value of the difference between x and y
+   is less than eps"
+  [x y eps]
+  (gc/< (abs (ga/- x y)) eps))
diff --git a/src/clojure/contrib/test_contrib/complex_numbers.clj b/src/clojure/contrib/test_contrib/complex_numbers.clj
index ef874ba1..b8b03f49 100644
--- a/src/clojure/contrib/test_contrib/complex_numbers.clj
+++ b/src/clojure/contrib/test_contrib/complex_numbers.clj
@@ -1,7 +1,7 @@
 ;; Test routines for complex-numbers.clj
 
 ;; by Konrad Hinsen
-;; last updated March 19, 2009
+;; last updated March 23, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2008. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -12,13 +12,15 @@
 ;; remove this notice, or any other, from this software.
 
 (ns clojure.contrib.test-contrib.complex-numbers
-  (:refer-clojure :exclude [+ - * / =])
+  (:refer-clojure :exclude [+ - * / = < > <= >=])
   (:use [clojure.contrib.test-is
 	 :only (deftest is are run-tests)]
 	[clojure.contrib.generic.arithmetic
 	 :only (+ - * /)]
 	[clojure.contrib.generic.comparison
-	 :only (=)]
+	 :only (= < > <= >=)]
+	[clojure.contrib.generic.math-functions
+	 :only (abs approx= conjugate sqr sqrt)]
 	[clojure.contrib.complex-numbers
 	 :only (complex imaginary real imag)]))
 
@@ -269,3 +271,21 @@
   (is (= (/ (imaginary 5) (imaginary -2)) -5/2))
   (is (= (/ (imaginary -2) (imaginary 5)) -2/5))
   (is (= (/ (imaginary 5) (imaginary 5)) 1)))
+
+(deftest complex-conjugate
+  (is (= (conjugate (complex 1 2)) (complex 1 -2)))
+  (is (= (conjugate (complex -3 -7)) (complex -3 7)))
+  (is (= (conjugate (imaginary -2)) (imaginary 2)))
+  (is (= (conjugate (imaginary 5)) (imaginary -5))))
+
+(deftest complex-abs
+  (doseq [c [(complex 1 2) (complex -3 -7) (imaginary -2) (imaginary 5)]]
+    (is (approx= (* c (conjugate c))
+		 (sqr (abs c))
+		 1e-14))))
+
+(deftest complex-sqrt
+  (doseq [c [(complex 1 2) (complex -3 -7) (imaginary -2) (imaginary 5)]]
+    (let [r (sqrt c)]
+      (is (approx= c (sqr r) 1e-14))
+      (is (>= (real r) 0)))))