|
1 | 1 |
|
2 | 2 | (defun coefficient (time-index freq-index dft-len)
|
3 | 3 | "Calculates a single twiddle factor for the Fourier Transform."
|
4 |
| - (exp (- (/ (* #c( 0 1) 2.0 pi time-index freq-index) |
| 4 | + (exp (- (/ (* #c(0 1) 2.0 pi time-index freq-index) |
5 | 5 | dft-len))))
|
6 | 6 |
|
7 | 7 | (defun dft (data)
|
|
14 | 14 | (defun merge-sub-ffts (evens odds)
|
15 | 15 | "Combines the FFTs of the even and odd indices"
|
16 | 16 | (let* ((fft-length (+ (length evens) (length odds)))
|
17 |
| - (indices (loop for i from 0 below (length odds) collect i)) |
18 |
| - (odd-terms (mapcar #'(lambda (v i) (* v (coefficient 1.0 i fft-length))) |
19 |
| - odds |
20 |
| - indices))) |
| 17 | + ;; Calculate coefficients for the odd indices. |
| 18 | + (twiddle-factors (loop for i from 0 below (length odds) |
| 19 | + collect (coefficient 1.0 i fft-length))) |
| 20 | + ;; Multiply values with coefficients |
| 21 | + (odd-terms (mapcar #'* odds twiddle-factors))) |
| 22 | + ;; Combine the two FFTs |
21 | 23 | (concatenate 'list
|
22 | 24 | (mapcar #'+ evens odd-terms)
|
23 | 25 | (mapcar #'- evens odd-terms))))
|
24 | 26 |
|
25 | 27 | (defun cooley-tukey-rec (data)
|
26 |
| - "Performs the DFT using the recursive Cooley-Tukey method." |
| 28 | + "Performs the Fourier Transform using the recursive Cooley-Tukey method." |
27 | 29 | (if (<= (length data) 1)
|
28 |
| - data |
29 |
| - (loop for i from 0 below (length data) |
30 |
| - if (evenp i) |
31 |
| - collect (elt data i) into evens |
32 |
| - else |
33 |
| - collect (elt data i) into odds |
34 |
| - finally |
35 |
| - (return (merge-sub-ffts (cooley-tukey-rec evens) |
36 |
| - (cooley-tukey-rec odds)))))) |
| 30 | + data |
| 31 | + (loop |
| 32 | + for i from 0 below (length data) |
| 33 | + ;; Split input into even and odd indices into two smaller lists. |
| 34 | + if (evenp i) |
| 35 | + collect (elt data i) into evens |
| 36 | + else |
| 37 | + collect (elt data i) into odds |
| 38 | + finally |
| 39 | + ;; Calculate the Fourier Transform for the two smaller lists and |
| 40 | + ;; combine them into the Fourier Transform for the full input. |
| 41 | + (return (merge-sub-ffts (cooley-tukey-rec evens) |
| 42 | + (cooley-tukey-rec odds)))))) |
37 | 43 |
|
38 | 44 | (defun reverse-bits (value num-bits)
|
39 | 45 | "Reverses the bits of a value"
|
40 | 46 | (if (= num-bits 1)
|
41 |
| - value |
42 |
| - (let* ((num-low-bits (floor (/ num-bits 2))) |
43 |
| - (num-high-bits (- num-bits num-low-bits)) |
44 |
| - (bit-mask (- (expt 2 num-low-bits) 1)) |
45 |
| - (lower-half (logand value bit-mask)) |
46 |
| - (upper-half (ash value (- num-low-bits)))) |
47 |
| - (logior (ash (reverse-bits lower-half num-low-bits) num-high-bits) |
48 |
| - (reverse-bits upper-half num-high-bits))))) |
| 47 | + value |
| 48 | + ;; Split bits into two parts |
| 49 | + (let* ((num-low-bits (floor (/ num-bits 2))) |
| 50 | + (num-high-bits (- num-bits num-low-bits)) |
| 51 | + (bit-mask (- (expt 2 num-low-bits) 1)) |
| 52 | + (lower-half (logand value bit-mask)) |
| 53 | + (upper-half (ash value (- num-low-bits)))) |
| 54 | + ;; Reverse the bits of each part, then swap the results. |
| 55 | + (logior (ash (reverse-bits lower-half num-low-bits) num-high-bits) |
| 56 | + (reverse-bits upper-half num-high-bits))))) |
49 | 57 |
|
50 | 58 | (defun bit-shuffle-indices (data)
|
51 | 59 | "Rearanges the elements in a list according to their bit-reversed indices."
|
|
61 | 69 | (defun butterfly-group (data start stride)
|
62 | 70 | "Calculates a single group of butterflies."
|
63 | 71 | (dotimes (i stride)
|
64 |
| - (let* ((a-index (+ start i)) |
65 |
| - (b-index (+ start i stride)) |
66 |
| - (a (elt data a-index)) |
67 |
| - (b (elt data b-index)) |
| 72 | + ;; Take two elements which are stride apart and perform a butterfly on them. |
| 73 | + (let* ((first-elt-index (+ start i)) |
| 74 | + (second-elt-index (+ start i stride)) |
| 75 | + (first-elt (elt data first-elt-index)) |
| 76 | + (second-elt (elt data second-elt-index)) |
68 | 77 | (coeff (coefficient 1.0 i (* 2 stride))))
|
69 |
| - (multiple-value-bind (sum difference) (butterfly a b coeff) |
70 |
| - (setf (elt data a-index) sum) |
71 |
| - (setf (elt data b-index) difference))))) |
72 |
| - |
73 |
| -(defun cooley-tukey-tailrec (data stride) |
74 |
| - "Actual iterative implementation of the Cooley-Tukey method." |
75 |
| - (if (>= stride (length data)) |
76 |
| - data |
77 |
| - (progn |
78 |
| - (loop for i from 0 below (length data) by (* 2 stride) do |
79 |
| - (butterfly-group data i stride)) |
80 |
| - (cooley-tukey-tailrec data (* 2 stride))))) |
| 78 | + (multiple-value-bind (sum difference) (butterfly first-elt second-elt coeff) |
| 79 | + ;; Write results back into the list. |
| 80 | + (setf (elt data first-elt-index) sum) |
| 81 | + (setf (elt data second-elt-index) difference))))) |
81 | 82 |
|
82 | 83 | (defun cooley-tukey-iter (data)
|
83 |
| - "Performs the DFT using the iterative Cooley-Tukey method." |
84 |
| - (cooley-tukey-tailrec (bit-shuffle-indices data) 1)) |
| 84 | + "Performs the Fourier Transform using the iterative Cooley-Tukey method." |
| 85 | + (loop |
| 86 | + ;; Bit-shuffle indices. |
| 87 | + with shuffled-data = (bit-shuffle-indices data) |
| 88 | + for stride = 1 then (* 2 stride) |
| 89 | + while (< stride (length shuffled-data)) |
| 90 | + do |
| 91 | + ;; Compute butterfly groups for the current stride. |
| 92 | + (loop for i from 0 below (length shuffled-data) by (* 2 stride) do |
| 93 | + (butterfly-group shuffled-data i stride)) |
| 94 | + finally (return shuffled-data))) |
85 | 95 |
|
86 | 96 | (defun approx-eql (list1 list2)
|
87 | 97 | (let ((diffs (mapcar #'(lambda (e1 e2) (abs (- e1 e2)))
|
|
0 commit comments