[lisplab-cvs] r100 - src/fft

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Fri Oct 16 14:20:14 2009
New Revision: 100

Log:
fft-shift

Modified:
   src/fft/level3-fft-generic.lisp
   src/fft/level3-fft-zge.lisp

Modified: src/fft/level3-fft-generic.lisp
==============================================================================
--- src/fft/level3-fft-generic.lisp	(original)
+++ src/fft/level3-fft-generic.lisp	Fri Oct 16 14:20:14 2009
@@ -53,3 +53,27 @@
 
 (defmethod fft2 ((x matrix-base-zge) &key)
   (fft2! (copy x)))
+
+(defmethod fft-shift ((m matrix-base))
+  (let* ((rows (rows m))
+         (fr (floor rows 2))
+         (cr (ceiling rows 2))
+         (cols (cols m))
+         (fc (floor cols 2))
+         (cc (ceiling cols 2)))      
+    (fmat (type-of m) (list rows cols) (i j) 
+      (mref m 
+            (if (< i fr) (+ i cr) (- i fr))
+            (if (< j fc) (+ j cc) (- j fc))))))
+
+(defmethod ifft-shift ((m matrix-base))
+  (let* ((rows (rows m))
+         (fr (floor rows 2))
+         (cr (ceiling rows 2))
+         (cols (cols m))
+         (fc (floor cols 2))
+         (cc (ceiling cols 2)))      
+    (fmat (type-of m) (list rows cols) (i j) 
+      (mref m 
+            (if (< i cr) (+ i fr) (- i cr))
+            (if (< j cc) (+ j fc) (- j cc))))))

Modified: src/fft/level3-fft-zge.lisp
==============================================================================
--- src/fft/level3-fft-zge.lisp	(original)
+++ src/fft/level3-fft-zge.lisp	Fri Oct 16 14:20:14 2009
@@ -21,12 +21,8 @@
 
 (in-package :lisplab)
 
-
-
 ;;;; The implementing methods
 
-
-
 (defmethod fft1! ((x matrix-lisp-zge) &key)
   (assert (= 1 (logcount (rows x))))
   (dotimes (i (cols x))
@@ -163,24 +159,3 @@
 	(incf j k))))
   vec)
 
-(defmethod fft-shift ((k matrix-base))
-  "Only for 2D. TODO 1d."
-  (let ((out (copy k))
-	(r/2 (/ (rows k) 2))
-	(c/2 (/ (cols k) 2)))
-    (dotimes (i (rows k))
-      (dotimes (j (cols k))
-	(setf (mref out i j)
-	      (cond ((and (< i r/2) (< j c/2))
-		     (mref k (+ i r/2) (+ j c/2)))
-		    ((and (< i r/2) (>= j c/2))
-		     (mref k (+ i r/2) (- j c/2)))
-		    ((and (>= i r/2) (< j c/2))
-		     (mref k (- i r/2) (+ j c/2)))
-		    (t 
-		     (mref k (- i r/2) (- j c/2))))))) 
-    out))
-
-(defmethod ifft-shift ((k matrix-base))
-  "Currently the same as fft-shift since only grids with power 2 sized grids are allowed."
-  (fft-shift k))
\ No newline at end of file