Unpdated norms with internal unit tests.0.9.2
authorThomas M. Hermann <thomas.m.hermann@odonata-research.com>
Tue, 16 Oct 2012 03:45:24 +0000 (15 22:45 -0500)
committerThomas M. Hermann <thomas.m.hermann@odonata-research.com>
Tue, 16 Oct 2012 03:45:24 +0000 (15 22:45 -0500)
README.md
extensions/floating-point.lisp
internal-test/floating-point.lisp [new file with mode: 0644]

index f468fd8..b215a87 100644 (file)
--- a/README.md
+++ b/README.md
@@ -18,7 +18,7 @@ loaded using either [Quicklisp][] or [ASDF][].
 2. Load using [Quicklisp][] : `(ql:quickload :lisp-unit)`.
 3. Load using [ASDF][] : `(asdf:load-system :lisp-unit)`.
 
-## Version 0.9.0 Features
+## Version 0.9.2 Features
 
 ### Simplified Interface
 
index ac0b341..9d0cf42 100644 (file)
@@ -372,65 +372,69 @@ comparison of the relative error is less than epsilon."
         p))
 
 ;;; (NORM data) => float
-(defun %seq-1-norm (data)
-  "Return the Taxicab norm of the sequence."
-  ;; FIXME : Use the LOOP.
-  (reduce (lambda (x y) (+ x (abs y)))
-          data :initial-value 0))
-
-(defun %seq-2-norm (data)
-  "Return the Euclidean norm of the sequence."
+
+(defgeneric %norm (data measure)
+  (:documentation
+   "Return the norm of the data according to measure."))
+
+(defmethod %norm ((data list) (measure (eql 1)))
+  "Return the Taxicab norm of the list."
+  (loop for item in data sum (abs item)))
+
+(defmethod %norm ((data vector) (measure (eql 1)))
+  "Return the Taxicab norm of the vector."
+  (loop for item across data sum (abs item)))
+
+(defmethod %norm ((data list) (measure (eql 2)))
+  "Return the Euclidean norm of the list."
+  (multiple-value-bind (scale sumsq)
+      (sumsq (map-into (make-array (length data)) #'abs data))
+    (* scale (sqrt sumsq))))
+
+(defmethod %norm ((data vector) (measure (eql 2)))
+  "Return the Euclidean norm of the vector."
   (multiple-value-bind (scale sumsq)
       (sumsq (map-into (make-array (length data)) #'abs data))
     (* scale (sqrt sumsq))))
 
-(defun %seq-p-norm (data p)
-  "Return the p norm of the sequence."
+(defmethod %norm ((data list) (measure integer))
+  "Return the Euclidean norm of the list."
   (multiple-value-bind (scale sump)
-      (sump (map-into (make-array (length data)) #'abs data) p)
-    (* scale (expt sump (/ p)))))
+      (sump (map-into (make-array (length data)) #'abs data)
+            measure)
+    (* scale (expt sump (/ measure)))))
 
-(defun %seq-inf-norm (data)
-  "Return the infinity, or maximum, norm of the sequence."
-  ;; FIXME : Use the LOOP.
-  (reduce (lambda (x y) (max x (abs y)))
-          data :initial-value 0))
+(defmethod %norm ((data vector) (measure integer))
+  "Return the Euclidean norm of the vector."
+  (multiple-value-bind (scale sump)
+      (sump (map-into (make-array (length data)) #'abs data)
+            measure)
+    (* scale (expt sump (/ measure)))))
 
-(defun %seq-norm (data measure)
-  "Return the norm of the sequence according to the measure."
-  (cond
-    ((equalp measure 1)
-     (%seq-1-norm data))
-    ((equalp measure 2)
-     (%seq-2-norm data))
-    ((numberp measure)
-     (%seq-p-norm data measure))
-    ((equalp measure :infinity)
-     (%seq-inf-norm data))
-    (t (error "Unrecognized norm, ~A." measure))))
+(defmethod %norm ((data list) (measure (eql :infinity)))
+  "Return the infinity, or maximum, norm of the list."
+  (loop for item in data maximize (abs item)))
+
+(defmethod %norm ((data vector) (measure (eql :infinity)))
+  "Return the infinity, or maximum, norm of the vector."
+  (loop for item across data maximize (abs item)))
 
 (defmethod norm ((data list) &optional (measure *measure*))
   "Return the norm of the list according to the measure."
-  (%seq-norm data measure))
+  (%norm data measure))
 
 (defmethod norm ((data vector) &optional (measure *measure*))
   "Return the norm of the vector according to the measure."
-  (%seq-norm data measure))
+  (%norm data measure))
 
 (defmethod norm ((data array) &optional (measure *measure*))
   "Return the entrywise norm of the array according to the measure."
-  (let ((flat-data (make-array (array-total-size data)
-                               :element-type (array-element-type data)
-                               :displaced-to data)))
-    (cond
-      ((and (numberp measure) (< 0 measure))
-       (warn "Measure ~D results in an entrywise p-norm." measure)
-       (%seq-p-norm flat-data measure))
-      ((equalp measure :frobenius)
-       (%seq-2-norm flat-data))
-      ((equalp measure :max)
-       (%seq-inf-norm flat-data))
-      (t (error "Unrecognized norm, ~A." measure)))))
+  (%norm
+   (make-array
+    (array-total-size data)
+    :element-type (array-element-type data)
+    :displaced-to data)
+   measure))
 
 ;;; (RELATIVE-ERROR-NORM exact approximate measure) => float
 (defun %relative-error-norm (exact approximate measure)
diff --git a/internal-test/floating-point.lisp b/internal-test/floating-point.lisp
new file mode 100644 (file)
index 0000000..2c89e58
--- /dev/null
@@ -0,0 +1,115 @@
+#|
+
+ LISP-UNIT Floating Point Tests
+
+ Copyright (c) 2010-2012, Thomas M. Hermann
+ All rights reserved.
+
+ Redistribution and  use  in  source  and  binary  forms, with or without
+ modification, are permitted  provided  that the following conditions are
+ met:
+
+   o  Redistributions of  source  code  must  retain  the above copyright
+      notice, this list of conditions and the following disclaimer.
+   o  Redistributions in binary  form  must reproduce the above copyright
+      notice, this list of  conditions  and  the  following disclaimer in
+      the  documentation  and/or   other   materials  provided  with  the
+      distribution.
+   o  The names of the contributors may not be used to endorse or promote
+      products derived from this software without  specific prior written
+      permission.
+
+ THIS SOFTWARE IS  PROVIDED  BY  THE  COPYRIGHT  HOLDERS AND CONTRIBUTORS
+ "AS IS"  AND  ANY  EXPRESS  OR  IMPLIED  WARRANTIES, INCLUDING,  BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR A
+ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ EXEMPLARY, OR  CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT  NOT LIMITED TO,
+ PROCUREMENT OF  SUBSTITUTE  GOODS  OR  SERVICES;  LOSS  OF USE, DATA, OR
+ PROFITS; OR BUSINESS INTERRUPTION)  HOWEVER  CAUSED AND ON ANY THEORY OF
+ LIABILITY, WHETHER  IN  CONTRACT,  STRICT  LIABILITY, OR TORT (INCLUDING
+ NEGLIGENCE OR  OTHERWISE)  ARISING  IN  ANY  WAY  OUT OF THE USE OF THIS
+ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+|#
+
+(in-package :lisp-unit)
+
+;;; List norms
+
+(define-test %norm-list
+  "Internal test of %norm on lists."
+  (:tag :norm)
+  ;; Taxicab norm
+  (assert-rational-equal
+   36 (%norm '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 1))
+  (assert-float-equal
+   19.535658
+   (%norm
+    '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+      #C(-2 3) #C(-3 1) #C(-1 0))
+    1))
+  ;; Euclidean norm
+  (assert-float-equal
+   12.083046
+   (%norm '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 2))
+  (assert-float-equal
+   8.0
+   (%norm
+    '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+      #C(-2 3) #C(-3 1) #C(-1 0)) 2))
+  ;; P-norm
+  (let ((data '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5))
+        (zdata '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+                 #C(-2 3) #C(-3 1) #C(-1 0))))
+    (assert-float-equal 8.732892 (%norm data 3))
+    (assert-float-equal 6.064035 (%norm zdata 3)))
+  ;; Infinity norm
+  (assert-rational-equal
+   6 (%norm
+      '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5)
+      :infinity))
+  (assert-float-equal
+   4.0 (%norm
+        '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+          #C(-2 3) #C(-3 1) #C(-1 0))
+        :infinity)))
+
+;;; Vector norms
+
+(define-test %norm-vector
+  "Internal test of %norm on vectors"
+  (:tag :norm)
+  ;; Taxicab norm
+  (assert-rational-equal
+   36 (%norm #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 1))
+  (assert-float-equal
+   19.535658
+   (%norm
+    #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+      #C(-2 3) #C(-3 1) #C(-1 0))
+    1))
+  ;; Euclidean norm
+  (assert-float-equal
+   12.083046
+   (%norm #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 2))
+  (assert-float-equal
+   8.0
+   (%norm
+    #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+      #C(-2 3) #C(-3 1) #C(-1 0))
+    2))
+  ;; P-norm
+  (let ((data #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5))
+        (zdata #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+                 #C(-2 3) #C(-3 1) #C(-1 0))))
+    (assert-float-equal 8.732892 (%norm data 3))
+    (assert-float-equal 6.064035 (%norm zdata 3)))
+  ;; Infinity norm
+  (assert-rational-equal
+   6 (%norm #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) :infinity))
+  (assert-float-equal
+   4.0 (%norm
+        #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
+          #C(-2 3) #C(-3 1) #C(-1 0))
+        :infinity)))