Commit 999255fe by Liam Healy

Split fft-noise test into FFT and DFT; test generation with supplied answer

The FFT noise test test-fft-noise calls a new split-out function
forward-fft-rc as well as the DFT "answer".  In preparation for the
generation of the test files, several functions in generate-tests.lisp
have been modified to accept a known answer, in lieu of evaluating the
form and saving that as the reference.
parent e635d8e7
;; Example FFT: transform a pulse (using the "clean" fft interface)
;; Sumant Oemrawsingh, Sat Oct 31 2009 - 00:24
;; Time-stamp: <2009-11-15 23:22:45EST example.lisp>
;; Time-stamp: <2009-11-16 23:10:53EST example.lisp>
(in-package :gsl)
......@@ -33,7 +33,7 @@
(forward-fourier-transform pulse)))
(fft-pulse-test '(complex single-float) 128)
(fft-pulse-test '(complex single-float) 630)
(fft-pulse-test '(complex double-float) 128)
......@@ -81,21 +81,27 @@
(realpart (maref complex-vector i))))
(defun forward-fft-rc (vector complexp &key (stride 1))
"Return the forward FFT of the vector."
(let ((forward
(if complexp
(copy vector)
(realpart-vector vector))
:stride stride)))
(if complexp
(unpack forward :unpack-type 'complex :stride stride))))
(defun test-fft-noise (element-type size &key (stride 1))
"Test for FFT with random data (noise); returns the DFT answer and the computed FFT answer.
See test_real_radix2 etc. in fft/"
(let* ((random-vector (make-urand-vector element-type size :stride stride))
(if (subtypep element-type 'complex)
(copy-making-destination random-vector)
(realpart-vector random-vector))
:stride stride)))
(let ((random-vector (make-urand-vector element-type size :stride stride)))
(forward-discrete-fourier-transform random-vector :stride stride)
(if (subtypep element-type 'complex)
(unpack forward :unpack-type 'complex :stride stride)))))
random-vector (subtypep element-type 'complex) :stride stride)
(forward-discrete-fourier-transform random-vector :stride stride))))
;;(test-fft-noise 'double-float 10 :stride 5)
;;(test-fft-noise '(complex double-float) 10 :stride 5)
;; Make tests from examples.
;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
;; Time-stamp: <2009-04-15 23:33:26EDT generate-tests.lisp>
;; $Id: $
;; Time-stamp: <2009-11-16 23:09:01EST generate-tests.lisp>
;;; Througout the GSLL interface definition files are #'save-test
;;; forms. These serve to define both examples and tests. Getting an
......@@ -31,9 +30,11 @@
;;; (make-test '(legendre-conicalP-half 3.5d0 10.0d0))
(defun make-test (form)
"Make a test for lisp-unit."
(let ((vals (multiple-value-list (ignore-errors (eval form)))))
(defun make-test (form &optional answer)
"Make a test for lisp-unit. If the answer is known separately from
evaluation of the form, it may be supplied in 'answer; note that
this only accommodates a single value at present."
(let ((vals (multiple-value-list (or answer (ignore-errors (eval form))))))
(if (typep (second vals) 'condition)
',(type-of (second vals))
......@@ -42,13 +43,15 @@
,(numerical-serialize vals)
(multiple-value-list ,form)))))
(defun create-test (test-name)
(defun create-test (test-name &optional answers)
"Find the saved test by name and create it, with the generated results."
`(lisp-unit:define-test ,test-name)
(mapcar #'make-test (getf *all-generated-tests* test-name))))
(let ((test-set (getf *all-generated-tests* test-name)))
(mapcar #'make-test test-set
(or answers (make-list (length test-set) :initial-element nil))))))
(defun write-test-to-file (test path)
(defun write-test-to-file (test path &optional answers)
"Write the test to a file with the same name under path.
Use this function with caution; it will replace an existing
test file and thus the opportunity for regression test will be lost."
......@@ -61,7 +64,7 @@
";; Regression test ~a for GSLL, automatically generated~%~%" test)
(format stream "(in-package :gsl)~%~%")
(format t "Writing test ~a to file ~a~&" test pathname)
(format stream "~s~%~%" (create-test test)))))
(format stream "~s~%~%" (create-test test answers)))))
;;; This is commented out because it shouldn't normally be run. It
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