Commit bc4d0b9a authored by Liam Healy's avatar Liam Healy

Add FFT tests

Add FFT tests; these are a subset of the GSL tests.  For some reason
the tests take a lot longer in GSLL, so instead of testing all sizes
1...99, we test only 1...9 and then 64 and 99 for stride 1 only.
parent 763b43d8
;; Example FFT: transform a pulse (using the "clean" fft interface)
;; Sumant Oemrawsingh, Sat Oct 31 2009 - 00:24
;; Time-stamp: <2010-07-07 14:21:55EDT example.lisp>
;; Time-stamp: <2010-08-14 16:08:02EDT example.lisp>
;;
;; Copyright 2009 Sumant Oemrawsingh, Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -99,7 +99,7 @@
(defun size-vector-real (vector &key (stride 1))
"Return the size of a vector while taking the stride into account."
(coerce (floor (size vector) stride) (element-type vector)))
(coerce (floor (size vector) stride) 'double-float))
(defun vector/length (vector stride)
(elt/ vector (size-vector-real vector :stride stride)))
......@@ -134,10 +134,10 @@
(multiple-value-bind (forward inverse backward)
(test-complex-fft-noise random-vector :stride stride)
(values
dft-random-vector
forward
random-vector
inverse
dft-random-vector ; DFT forward result for reference
forward ; FFT forward result; should check
random-vector ; The original vector for reference
inverse ; The inverse FFT applied to the forward result
(if (and (have-at-least-gsl-version '(1 12)) #+fsbv t #-fsbv nil)
(elt/ (copy backward) (size-vector-real backward :stride stride))
;; Hack for old GSL version without complex vector math
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2010-07-06 23:52:30EDT gsll-tests.asd>
;; Time-stamp: <2010-08-14 18:30:13EDT gsll-tests.asd>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -76,6 +76,7 @@
(:file "exponential-integrals")
(:file "exponential")
(:file "exponential-power")
(:file "fast-fourier-transform")
(:file "fdist")
(:file "fermi-dirac")
(:file "flat")
......
;; Fast fourier transform tests
;; Liam Healy 2010-08-14 11:58:26EDT fast-fourier-transform.lisp
;; Time-stamp: <2010-08-14 18:32:54EDT fast-fourier-transform.lisp>
;;
;; Copyright 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :gsl)
(defvar *allowed-ticks* 1000000)
(defmacro fft-complex-result-check (form)
"T if all FFT tests pass."
`(multiple-value-bind
(dft fft original fft-roundtrip fft-reverse)
(reset-urand)
,form
(let ((lisp-unit:*epsilon* (* *allowed-ticks* +dbl-epsilon+))
(lisp-unit:*measure* :infinity))
(lisp-unit:assert-norm-equal dft fft)
(lisp-unit:assert-norm-equal original fft-roundtrip)
(lisp-unit:assert-norm-equal original fft-reverse))))
(defmacro fft-real-result-check (form)
"T if all FFT tests pass."
`(multiple-value-bind
(dft fft original fft-roundtrip)
(reset-urand)
,form
(let ((lisp-unit:*epsilon* (* *allowed-ticks* +dbl-epsilon+))
(lisp-unit:*measure* :infinity))
(lisp-unit:assert-norm-equal dft fft)
(lisp-unit:assert-norm-equal original fft-roundtrip))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun fft-test-forms (size stride)
`((fft-real-result-check
(test-fft-noise 'double-float ,size :stride ,stride))
(fft-real-result-check
(test-fft-noise 'single-float ,size :stride ,stride))
(fft-complex-result-check
(test-fft-noise '(complex double-float) ,size :stride ,stride))
(fft-complex-result-check
(test-fft-noise '(complex single-float) ,size :stride ,stride)))))
(defmacro all-fft-test-forms (size-max stride-max &optional additional-single-stride)
`(lisp-unit:define-test fast-fourier-transform
,@(loop for size from 1 to size-max
append
(loop for stride from 1 to stride-max
append (fft-test-forms size stride)))
,@(when additional-single-stride
(loop for size in additional-single-stride
append
(fft-test-forms size 1)))))
(all-fft-test-forms 9 3 (64 99))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment