From d14dc37230a575b6c47d0bf02844621c8adf7f89 Mon Sep 17 00:00:00 2001
From: Sumant Oemrawsingh <soemraws@xs4all.nl>
Date: Sun, 15 Nov 2009 04:09:30 +0100
Subject: [PATCH] Completed additions for stride

Unpack functions were still not properly handling strides. This is now fixed.
The test-real-radix2 function (from GSL's original test_real_radix2) now also
works with strides. The function is not yet complete, though, as it does not
yet test backward/inverse functions, and also doesn't actually perform
comparisons yet.
---
 fast-fourier-transforms/example.lisp | 18 ++++++++++--------
 fast-fourier-transforms/unpack.lisp  | 12 ++++++------
 2 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/fast-fourier-transforms/example.lisp b/fast-fourier-transforms/example.lisp
index c7175987..a77bc902 100644
--- a/fast-fourier-transforms/example.lisp
+++ b/fast-fourier-transforms/example.lisp
@@ -50,10 +50,10 @@
     (values)))
 
 ;; (make-urand-vector '(complex double-float) 5)
-(defun make-urand-vector (element-type dimension)
+(defun make-urand-vector (element-type dimension &key (stride 1))
   "Make a vector with random elements."
-  (let ((vec (make-marray element-type :dimensions (list dimension))))
-    (loop for i from 0 below dimension
+  (let ((vec (make-marray element-type :dimensions (list (* stride dimension)))))
+    (loop for i from 0 below (* stride dimension) by stride
        do
        (setf (maref vec i) (complex (urand))))
     vec))
@@ -69,12 +69,14 @@
 	       (realpart (maref complex-vector i))))
     real-vector))
 
-(defun test-real-radix2 (element-type size)
+(defun test-real-radix2 (element-type size &key (stride 1))
   "Test for FFT; returns the DFT answer and the computed FFT answer.
    See test_real_radix2 in fft/test.mc."
-  (let ((random-vector (make-urand-vector (list 'complex element-type) size)))
+  (let ((random-vector (make-urand-vector (list 'complex element-type) size :stride stride)))
     (values
-     (forward-discrete-fourier-transform random-vector)
+     (forward-discrete-fourier-transform random-vector :stride stride)
      (unpack
-      (forward-fourier-transform (realpart-vector random-vector))
-      :unpack-type 'complex))))
+      (forward-fourier-transform (realpart-vector random-vector) :stride stride)
+      :unpack-type 'complex :stride stride))))
+
+;;(test-real-radix2 'double-float 10 :stride 5)
diff --git a/fast-fourier-transforms/unpack.lisp b/fast-fourier-transforms/unpack.lisp
index e9a1852e..2d4786cc 100644
--- a/fast-fourier-transforms/unpack.lisp
+++ b/fast-fourier-transforms/unpack.lisp
@@ -14,9 +14,9 @@
      &key (stride 1)
      (output
 	 (eltcase single-float
-		  (make-marray '(complex single-float) :dimensions (floor (size vector) stride))
+		  (make-marray '(complex single-float) :dimensions (size vector))
 		  t
-		  (make-marray '(complex double-float) :dimensions (floor (size vector) stride)))))
+		  (make-marray '(complex double-float) :dimensions (size vector)))))
   ("gsl_fft_real" :type "_unpack")
   (((c-pointer vector) :pointer)
    ((c-pointer output) :pointer)
@@ -38,9 +38,9 @@
      &key (stride 1)
      (output
 	 (eltcase single-float
-		  (make-marray '(complex single-float) :dimensions (floor (size vector) stride))
+		  (make-marray '(complex single-float) :dimensions (size vector))
 		  t
-		  (make-marray '(complex double-float) :dimensions (floor (size vector) stride)))))
+		  (make-marray '(complex double-float) :dimensions (size vector)))))
   ("gsl_fft_halfcomplex" :type "_radix2_unpack")
   (((c-pointer vector) :pointer)
    ((c-pointer output) :pointer)
@@ -61,9 +61,9 @@
      &key (stride 1)
      (output
 	 (eltcase single-float
-		  (make-marray '(complex single-float) :dimensions (floor (size vector) stride))
+		  (make-marray '(complex single-float) :dimensions (size vector))
 		  t
-		  (make-marray '(complex double-float) :dimensions (floor (size vector) stride)))))
+		  (make-marray '(complex double-float) :dimensions (size vector)))))
   ("gsl_fft_halfcomplex" :type "_unpack")
   (((c-pointer vector) :pointer)
    ((c-pointer output) :pointer)
-- 
GitLab