test-support.lisp

(in-package "NAPA-FFT.TESTS")

(defun impulse (i n)
  (let ((vec (make-array n :element-type 'complex-sample
                           :initial-element (complex 0d0 0d0))))
    (setf (aref vec i) (complex 1d0 0d0))
    vec))

(defun iota (n)
  (let ((count 0))
    (map-into (make-array n :element-type 'complex-sample)
              (lambda ()
                (complex (1- (incf count))
                         1d0)))))

(defun make-vector (n)
  (make-array n :element-type 'complex-sample))

(defun random-vector (n &optional (dst (make-vector n)))
  (declare (type complex-sample-array dst))
  (unless (= n (length dst))
    (setf dst (make-array n :element-type 'complex-sample)))
  (map-into dst (lambda ()
                  (complex (- (random 2d0) 1d0)
                           (- (random 2d0) 1d0)))))

(macrolet ((define-mfun (name op)
             `(defun ,name (x y &optional (dst (make-vector (length x))))
                (declare (type complex-sample-array x y dst))
                (map-into dst #',op x y))))
  (define-mfun m+ +)
  (define-mfun m- -)
  (define-mfun m* *))

(defvar *default-abs-tol* 1d-6)

(defun m= (x y &optional (tol *default-abs-tol*))
  (declare (type complex-sample-array x y)
           (type double-float tol))
  (let ((worst 0d0))
    (declare (type double-float worst))
    (dotimes (i (length x))
      (let ((x (aref x i))
            (y (aref y i)))
        (let ((delta (abs (- x y))))
          (if (< delta tol)
              (setf worst (max worst delta))
              (return-from m= (values nil delta i))))))
    (values t worst nil)))

(defun slow-bit-reverse (array)
  (let ((dst (copy-seq array))
        (width (integer-length (1- (length array)))))
    (flet ((rev (x)
             (bit-reverse-integer x width)))
      (dotimes (i (length array) dst)
        (setf (aref dst (rev i)) (aref array i))))))