1 (defpackage #:cl-fftw3-tests
2 (:nicknames #:fftw3-tests)
3 (:use #:cl #:rtest #:cl-fftw3))
5 (in-package #:cl-fftw3-tests)
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))
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))
17 (defun vectors-close-p (v1 v2)
18 (unless (eql (length v1) (length v2))
19 (return-from vectors-close-p nil))
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)))
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)))
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)))
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*))
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)))
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)))
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)))
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)))
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)))
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)))
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)
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)
109 (deftest :eqlc.1 (vectors-close-p
111 (fftw-c-1d (fftw-c-1d *ac7* :normalize t :direction +fftw-forward+)
112 :normalize nil :direction +fftw-backward+))
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)
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)
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)
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)
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)
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)
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))))
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))))
215 (deftest :r2c-octave.1
216 (vectors-close-p *a7c* *a7c-octave*) t)
218 (deftest :r2c-octave.2
219 (vectors-close-p *a8c* *a8c-octave*) t)
221 (deftest :c2c-octave.1
222 (vectors-close-p (fftw-c-1d *ac7*) *ac7c-octave*) t)
224 (deftest :c2c-octave.2
225 (vectors-close-p (fftw-c-1d *cc7*) *cc7c-octave*) t)
227 (deftest :c2c-octave.3
228 (vectors-close-p (fftw-c-1d *ac8*) *ac8c-octave*) t)
230 (deftest :c2c-octave.4
231 (vectors-close-p (fftw-c-1d *cc8*) *cc8c-octave*) t)