tests.lisp

   1 (defpackage #:cl-fftw3-tests
   2   (:nicknames #:fftw3-tests)
   3   (:use #:cl #:rtest #:cl-fftw3))
   4
   5 (in-package #:cl-fftw3-tests)
   6
   7 (defun double-float-close-p (d1 d2 &key (epsilon 1d-7))
   8   (when (and (zerop d1) (zerop d2))
   9     (return-from double-float-close-p t))
  10
  11   (let* ((delta (abs (- d1 d2)))
  12          (eps (/ delta (max (abs d1) (abs d2)))))
  13     (when (or (and (zerop (min (abs d1) (abs d2))) (< (max (abs d1) (abs d2)) epsilon))
  14               (< eps epsilon))
  15       t)))
  16
  17 (defun vectors-close-p (v1 v2)
  18   (unless (eql (length v1) (length v2))
  19     (return-from vectors-close-p nil))
  20
  21   (dotimes (i (length v1))
  22     (unless (and (double-float-close-p (realpart (aref v1 i)) (realpart (aref v2 i)))
  23                  (double-float-close-p (imagpart (aref v1 i)) (imagpart (aref v2 i))))
  24       (return-from vectors-close-p nil)))
  25   t)
  26
  27 (rem-all-tests)
  28
  29 (defparameter *a7* #(0 1 2 3 2 1 0))
  30 (defparameter *a8* #(0 1 2 3 3 2 1 0))
  31 (defparameter *ac7* #(#C(0 0) #C(1 1) #C(2 2) #C(3 3) #C(2 2) #C(1 1) #C(0 0)))
  32 (defparameter *ac8* #(#C(0 0) #C(1 1) #C(2 2) #C(3 3) #C(3 3) #C(2 2) #C(1 1) #C(0 0)))
  33 (defparameter *cc7* #(#C(0 1) #C(1 1) #C(2 2) #C(3 3) #C(2 2) #C(1 1) #C(0 0)))
  34 (defparameter *cc8* #(#C(0 1) #C(1 1) #C(2 2) #C(3 3) #C(3 3) #C(2 2) #C(1 1) #C(0 0)))
  35
  36 (defparameter *b7* #(3 2 1 0 1 2 3))
  37 (defparameter *b8* #(3 2 1 0 0 1 2 3))
  38 (defparameter *bc7* #(#C(3 3) #C(2 2) #C(1 1) #C(0 0) #C(1 1) #C(2 2) #C(3 3)))
  39 (defparameter *bc8* #(#C(3 3) #C(2 2) #C(1 1) #C(0 0) #C(0 0) #C(1 1) #C(2 2) #C(3 3)))
  40
  41 (defparameter *a7hc* (fftw-r2hc-1d *a7*))
  42 (defparameter *a8hc* (fftw-r2hc-1d *a8*))
  43 (defparameter *a7c* (fftw-r2c-1d *a7*))
  44 (defparameter *a8c* (fftw-r2c-1d *a8*))
  45 (defparameter *ac7c* (fftw-c-1d *a7*))
  46 (defparameter *ac8c* (fftw-c-1d *a8*))
  47
  48 (defparameter *a7c-octave* #(#C(1.28571428571428580945d0 0d0)
  49                              #C(-0.64984533421747225912d0 -0.31294901910963018876d0)
  50                              #C(0.02743163880429938875d0  0.03439818705768063478d0)
  51                              #C(-0.02044344744397007946d0 -0.08956859554733599682d0)))
  52
  53 (defparameter *a8c-octave* #(#C(1.50000000000000000000d0 0.00000000000000000000d0)
  54                              #C(-0.72855339059327373086d0 -0.30177669529663686543d0)
  55                              #C(0.00000000000000000000d0 0.00000000000000000000d0)
  56                              #C(-0.02144660940672621363d0 -0.05177669529663689318d0)
  57                              #C(0.00000000000000000000d0 0.00000000000000000000d0)))
  58
  59 (defparameter *ac7c-octave* #(#C(1.28571428571428580945d0 1.28571428571428580945d0)
  60                               #C(-0.33689631510784201485d0 -0.96279435332710250339d0)
  61                               #C(-0.00696654825338124516d0 0.06182982586198002700d0)
  62                               #C(0.06912514810336592430d0 -0.11001204299130606934d0)
  63                               #C(-0.11001204299130606934d0 0.06912514810336592430d0)
  64                               #C(0.06182982586198002700d0 -0.00696654825338124516d0)
  65                               #C(-0.96279435332710250339d0 -0.33689631510784201485d0)))
  66
  67 (defparameter *cc7c-octave* #(#C(1.28571428571428580945d0 1.42857142857142860315d0)
  68                               #C(-0.33689631510784201485d0 -0.81993721046995970969d0)
  69                               #C(-0.00696654825338124516d0 0.20468696871912286928d0)
  70                               #C(0.06912514810336592430d0 0.03284509986583677293d0)
  71                               #C(-0.11001204299130606934d0 0.21198229096050877351d0)
  72                               #C(0.06182982586198002700d0 0.13589059460376159971d0)
  73                               #C(-0.96279435332710250339d0 -0.19403917225069916563d0)))
  74
  75 (defparameter *ac8c-octave* #(#C(1.50000000000000000000d0 1.50000000000000000000d0)
  76                               #C(-0.42677669529663686543d0 -1.03033008588991070731d0)
  77                               #C(0.00000000000000000000d0 0.00000000000000000000d0)
  78                               #C(0.03033008588991070731d0 -0.07322330470336310682d0)
  79                               #C(0.00000000000000000000d0 0.00000000000000000000d0)
  80                               #C(-0.07322330470336310682d0 0.03033008588991070731d0)
  81                               #C(0.00000000000000000000d0 0.00000000000000000000d0)
  82                               #C(-1.03033008588991070731d0 -0.42677669529663686543d0)))
  83
  84 (defparameter *cc8c-octave* #(#C(1.50000000000000000000d0 1.62500000000000000000d0)
  85                               #C(-0.42677669529663686543d0 -0.90533008588991070731)
  86                               #C(0.00000000000000000000d0 0.12500000000000000000d0)
  87                               #C(0.03033008588991070731d0 0.05177669529663689318d0)
  88                               #C(0.00000000000000000000d0 0.12500000000000000000d0)
  89                               #C(-0.07322330470336310682d0 0.15533008588991070731d0)
  90                               #C(0.00000000000000000000d0 0.12500000000000000000d0)
  91                               #C(-1.03033008588991070731d0 -0.30177669529663686543d0)))
  92
  93 (deftest :len.1 (length *a7*) 7)
  94 (deftest :len.2 (length *a8*) 8)
  95 (deftest :len.3 (length *a7hc*) 7)
  96 (deftest :len.4 (length *a8hc*) 8)
  97 (deftest :len.5 (length *a7c*) 4)
  98 (deftest :len.6 (length *a8c*) 5)
  99 (deftest :len.7 (length *b7*) 7)
 100 (deftest :len.8 (length *b8*) 8)
 101
 102 (deftest :eql.1 (vectors-close-p *a7* (fftw-hc2r-1d *a7hc*)) t)
 103 (deftest :eql.2 (vectors-close-p *a8* (fftw-hc2r-1d *a8hc*)) t)
 104 (deftest :eql.3 (vectors-close-p *a7* (fftw-c2r-1d *a7c*)) t)
 105 (deftest :eql.4 (vectors-close-p *a8* (fftw-c2r-1d *a8c*)) t)
 106 (deftest :eql.5 (vectors-close-p *a7* (fftw-c-1d *ac7c* :normalize nil :direction +fftw-backward+)) t)
 107 (deftest :eql.6 (vectors-close-p *a8* (fftw-c-1d *ac8c* :normalize nil :direction +fftw-backward+)) t)
 108
 109 (deftest :eqlc.1 (vectors-close-p
 110                   *ac7*
 111                   (fftw-c-1d (fftw-c-1d *ac7* :normalize t :direction +fftw-forward+)
 112                              :normalize nil :direction +fftw-backward+))
 113   t)
 114
 115 (deftest :multi.1
 116     (let* ((multi-r2hc (make-fftw-r2r-1d-multi (length *a7*) +fftw-r2hc+))
 117            (multi-hc2r (make-fftw-r2r-1d-multi (length *a7*) +fftw-hc2r+))
 118            (a7hc (copy-seq (fftw-r2r-1d-multi multi-r2hc *a7*)))
 119            (b7hc (copy-seq (fftw-r2r-1d-multi multi-r2hc *b7*)))
 120            (a7r (copy-seq (fftw-r2r-1d-multi multi-hc2r a7hc :normalize nil)))
 121            (b7r (copy-seq  (fftw-r2r-1d-multi multi-hc2r b7hc :normalize nil)))
 122            (eq (and (vectors-close-p *a7* a7r) (vectors-close-p *b7* b7r) t)))
 123       (destroy-fftw-multi multi-r2hc)
 124       (destroy-fftw-multi multi-hc2r)
 125       eq)
 126   t)
 127
 128 (deftest :multi.2
 129     (let* ((multi-r2hc (make-fftw-r2r-1d-multi (length *a8*) +fftw-r2hc+))
 130            (multi-hc2r (make-fftw-r2r-1d-multi (length *a8*) +fftw-hc2r+))
 131            (a8hc (copy-seq (fftw-r2r-1d-multi multi-r2hc *a8*)))
 132            (b8hc (copy-seq (fftw-r2r-1d-multi multi-r2hc *b8*)))
 133            (a8r (copy-seq (fftw-r2r-1d-multi multi-hc2r a8hc :normalize nil)))
 134            (b8r (copy-seq  (fftw-r2r-1d-multi multi-hc2r b8hc :normalize nil)))
 135            (eq (and (vectors-close-p *a8* a8r) (vectors-close-p *b8* b8r) t)))
 136       (destroy-fftw-multi multi-r2hc)
 137       (destroy-fftw-multi multi-hc2r)
 138       eq)
 139   t)
 140
 141 (deftest :multi.3
 142     (let* ((multi-r2c (make-fftw-r2c-1d-multi (length *a7*)))
 143            (a7c (copy-seq (fftw-r2c-1d-multi multi-r2c *a7*)))
 144            (b7c (copy-seq (fftw-r2c-1d-multi multi-r2c *b7*)))
 145            (a7 (fftw-c2r-1d a7c))
 146            (b7 (fftw-c2r-1d b7c))
 147            (eq (and (vectors-close-p *a7* a7)
 148                     (vectors-close-p *b7* b7))))
 149       (destroy-fftw-multi multi-r2c)
 150       eq)
 151   t)
 152
 153 (deftest :multi.4
 154     (let* ((multi-r2c (make-fftw-r2c-1d-multi (length *a8*)))
 155            (a8c (copy-seq (fftw-r2c-1d-multi multi-r2c *a8*)))
 156            (b8c (copy-seq (fftw-r2c-1d-multi multi-r2c *b8*)))
 157            (a8 (fftw-c2r-1d a8c))
 158            (b8 (fftw-c2r-1d b8c))
 159            (eq (and (vectors-close-p *a8* a8)
 160                     (vectors-close-p *b8* b8))))
 161       (destroy-fftw-multi multi-r2c)
 162       eq)
 163   t)
 164
 165 (deftest :multi.5
 166     (let* ((multi-r2c (make-fftw-r2c-1d-multi (length *a7*)))
 167            (a7c (copy-seq (fftw-r2c-1d-multi multi-r2c *a7*)))
 168            (b7c (copy-seq (fftw-r2c-1d-multi multi-r2c *b7*)))
 169            (multi-c2r (make-fftw-c2r-1d-multi (length a7c)))
 170            (a7r (copy-seq (fftw-c2r-1d-multi multi-c2r a7c)))
 171            (b7r (copy-seq (fftw-c2r-1d-multi multi-c2r b7c)))
 172            (eq (and (vectors-close-p *a7* a7r) (vectors-close-p *b7* b7r) t)))
 173       (destroy-fftw-multi multi-r2c)
 174       (destroy-fftw-multi multi-c2r)
 175       eq)
 176   t)
 177
 178 (deftest :multi.6
 179     (let* ((multi-r2c (make-fftw-r2c-1d-multi (length *a8*)))
 180            (a8c (copy-seq (fftw-r2c-1d-multi multi-r2c *a8*)))
 181            (b8c (copy-seq (fftw-r2c-1d-multi multi-r2c *b8*)))
 182            (multi-c2r (make-fftw-c2r-1d-multi (length a8c)))
 183            (a8r (copy-seq (fftw-c2r-1d-multi multi-c2r a8c)))
 184            (b8r (copy-seq (fftw-c2r-1d-multi multi-c2r b8c)))
 185            (eq (and (vectors-close-p *a8* a8r) (vectors-close-p *b8* b8r) t)))
 186       (destroy-fftw-multi multi-r2c)
 187       (destroy-fftw-multi multi-c2r)
 188       eq)
 189   t)
 190
 191 (deftest :c2c.1
 192     (let* ((ac7c (fftw-c-1d *ac7*))
 193            (bc7c (fftw-c-1d *bc7*))
 194            (cc7c (fftw-c-1d *cc7*))
 195            (ac7i (fftw-c-1d ac7c :direction +fftw-backward+ :normalize nil))
 196            (bc7i (fftw-c-1d bc7c :direction +fftw-backward+ :normalize nil))
 197            (cc7i (fftw-c-1d cc7c :direction +fftw-backward+ :normalize nil))
 198            (eq (and (vectors-close-p *ac7* ac7i) (vectors-close-p *bc7* bc7i)
 199                     (vectors-close-p *cc7* cc7i))))
 200       eq)
 201   t)
 202
 203 (deftest :c2c.2
 204     (let* ((ac8c (fftw-c-1d *ac8*))
 205            (bc8c (fftw-c-1d *bc8*))
 206            (cc8c (fftw-c-1d *cc8*))
 207            (ac8i (fftw-c-1d ac8c :direction +fftw-backward+ :normalize nil))
 208            (bc8i (fftw-c-1d bc8c :direction +fftw-backward+ :normalize nil))
 209            (cc8i (fftw-c-1d cc8c :direction +fftw-backward+ :normalize nil))
 210            (eq (and (vectors-close-p *ac8* ac8i) (vectors-close-p *bc8* bc8i)
 211                     (vectors-close-p *cc8* cc8i))))
 212       eq)
 213   t)
 214
 215 (deftest :r2c-octave.1
 216     (vectors-close-p *a7c* *a7c-octave*) t)
 217
 218 (deftest :r2c-octave.2
 219     (vectors-close-p *a8c* *a8c-octave*) t)
 220
 221 (deftest :c2c-octave.1
 222     (vectors-close-p (fftw-c-1d *ac7*) *ac7c-octave*) t)
 223
 224 (deftest :c2c-octave.2
 225     (vectors-close-p (fftw-c-1d *cc7*) *cc7c-octave*) t)
 226
 227 (deftest :c2c-octave.3
 228     (vectors-close-p (fftw-c-1d *ac8*) *ac8c-octave*) t)
 229
 230 (deftest :c2c-octave.4
 231     (vectors-close-p (fftw-c-1d *cc8*) *cc8c-octave*) t)