internal-test/floating-point.lisp

   1 #|
   2
   3  LISP-UNIT Floating Point Tests
   4
   5  Copyright (c) 2010-2012, Thomas M. Hermann
   6  All rights reserved.
   7
   8  Redistribution and  use  in  source  and  binary  forms, with or without
   9  modification, are permitted  provided  that the following conditions are
  10  met:
  11
  12    o  Redistributions of  source  code  must  retain  the above copyright
  13       notice, this list of conditions and the following disclaimer.
  14    o  Redistributions in binary  form  must reproduce the above copyright
  15       notice, this list of  conditions  and  the  following disclaimer in
  16       the  documentation  and/or   other   materials  provided  with  the
  17       distribution.
  18    o  The names of the contributors may not be used to endorse or promote
  19       products derived from this software without  specific prior written
  20       permission.
  21
  22  THIS SOFTWARE IS  PROVIDED  BY  THE  COPYRIGHT  HOLDERS AND CONTRIBUTORS
  23  "AS IS"  AND  ANY  EXPRESS  OR  IMPLIED  WARRANTIES, INCLUDING,  BUT NOT
  24  LIMITED TO, THE IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR A
  25  PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
  26  OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  27  EXEMPLARY, OR  CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT  NOT LIMITED TO,
  28  PROCUREMENT OF  SUBSTITUTE  GOODS  OR  SERVICES;  LOSS  OF USE, DATA, OR
  29  PROFITS; OR BUSINESS INTERRUPTION)  HOWEVER  CAUSED AND ON ANY THEORY OF
  30  LIABILITY, WHETHER  IN  CONTRACT,  STRICT  LIABILITY, OR TORT (INCLUDING
  31  NEGLIGENCE OR  OTHERWISE)  ARISING  IN  ANY  WAY  OUT OF THE USE OF THIS
  32  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  33
  34 |#
  35
  36 (in-package :lisp-unit)
  37
  38 ;;; List norms
  39
  40 (define-test %norm-list
  41   "Internal test of %norm on lists."
  42   (:tag :norm)
  43   ;; Taxicab norm
  44   (assert-rational-equal
  45    36 (%norm '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 1))
  46   (assert-float-equal
  47    19.535658
  48    (%norm
  49     '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
  50       #C(-2 3) #C(-3 1) #C(-1 0))
  51     1))
  52   ;; Euclidean norm
  53   (assert-float-equal
  54    12.083046
  55    (%norm '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 2))
  56   (assert-float-equal
  57    8.0
  58    (%norm
  59     '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
  60       #C(-2 3) #C(-3 1) #C(-1 0)) 2))
  61   ;; P-norm
  62   (let ((data '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5))
  63         (zdata '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
  64                  #C(-2 3) #C(-3 1) #C(-1 0))))
  65     (assert-float-equal 8.732892 (%norm data 3))
  66     (assert-float-equal 6.064035 (%norm zdata 3)))
  67   ;; Infinity norm
  68   (assert-rational-equal
  69    6 (%norm
  70       '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5)
  71       :infinity))
  72   (assert-float-equal
  73    4.0 (%norm
  74         '(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
  75           #C(-2 3) #C(-3 1) #C(-1 0))
  76         :infinity)))
  77
  78 ;;; Vector norms
  79
  80 (define-test %norm-vector
  81   "Internal test of %norm on vectors"
  82   (:tag :norm)
  83   ;; Taxicab norm
  84   (assert-rational-equal
  85    36 (%norm #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 1))
  86   (assert-float-equal
  87    19.535658
  88    (%norm
  89     #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
  90       #C(-2 3) #C(-3 1) #C(-1 0))
  91     1))
  92   ;; Euclidean norm
  93   (assert-float-equal
  94    12.083046
  95    (%norm #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) 2))
  96   (assert-float-equal
  97    8.0
  98    (%norm
  99     #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
 100       #C(-2 3) #C(-3 1) #C(-1 0))
 101     2))
 102   ;; P-norm
 103   (let ((data #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5))
 104         (zdata #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
 105                  #C(-2 3) #C(-3 1) #C(-1 0))))
 106     (assert-float-equal 8.732892 (%norm data 3))
 107     (assert-float-equal 6.064035 (%norm zdata 3)))
 108   ;; Infinity norm
 109   (assert-rational-equal
 110    6 (%norm #(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5) :infinity))
 111   (assert-float-equal
 112    4.0 (%norm
 113         #(#C(1 0) #C(3 1) #C(2 3) #C(0 4)
 114           #C(-2 3) #C(-3 1) #C(-1 0))
 115         :infinity)))