Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Unpdated norms with internal unit tests.

  • Loading branch information...
commit 2d1abfffec61a842c734ec6acb64c49c847f02fb 1 parent 93d07b2
Thomas M. Hermann authored
View
2  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
View
90 extensions/floating-point.lisp
@@ -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)
View
115 internal-test/floating-point.lisp
@@ -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)))
Please sign in to comment.
Something went wrong with that request. Please try again.