A-M baby

Task/Fast-Fourier-transform/0DESCRIPTION

@@ -0,0 +1 @@
+The purpose of this task is to calculate the FFT (Fast Fourier Transform) of an input sequence. The most general case allows for complex numbers at the input and results in a sequence of equal length, again of complex numbers. If you need to restrict yourself to real numbers the output should be the magnitude (i.e. sqrt(re²+im²)) of the complex result. The classic version is the recursive Cooley–Tukey FFT. [http://en.wikipedia.org/wiki/Cooley–Tukey_FFT_algorithm Wikipedia] has pseudocode for that. Further optimizations are possible but not required.

Task/Fast-Fourier-transform/ALGOL-68/fast-fourier-transform-1.alg

@@ -0,0 +1,38 @@
+PRIO DICE = 9; # ideally = 11 #
+
+OP DICE = ([]SCALAR in, INT step)[]SCALAR: (
+    ### Dice the array, extract array values a "step" apart ###
+    IF step = 1 THEN
+        in
+    ELSE
+        INT upb out := 0;
+        [(UPB in-LWB in)%step+1]SCALAR out;
+        FOR index FROM LWB in BY step TO UPB in DO
+            out[upb out+:=1] := in[index] OD;
+        out[@LWB in]
+    FI
+);
+
+PROC fft = ([]SCALAR in t)[]SCALAR: (
+    ### The Cooley-Tukey FFT algorithm ###
+    IF LWB in t >= UPB in t THEN
+      in t[@0]
+    ELSE
+        []SCALAR t = in t[@0];
+        INT n = UPB t + 1, half n = n % 2;
+        [LWB t:UPB t]SCALAR coef;
+
+        []SCALAR even = fft(t    DICE 2),
+                  odd = fft(t[1:]DICE 2);
+
+        COMPL i = 0 I 1;
+
+        REAL w =  2*pi / n;
+        FOR k FROM LWB t TO half n-1 DO
+            COMPL cis t = scalar exp(0 I (-w * k))*odd[k];
+            coef[k]          := even[k] + cis t;
+            coef[k + half n] := even[k] - cis t
+        OD;
+        coef
+    FI
+);

Task/Fast-Fourier-transform/ALGOL-68/fast-fourier-transform-2.alg

@@ -0,0 +1,22 @@
+#!/usr/local/bin/a68g --script #
+# -*- coding: utf-8 -*- #
+
+MODE SCALAR = COMPL;
+PROC (COMPL)COMPL scalar exp = complex exp;
+PR READ "Template.Fast_Fourier_transform.a68" PR
+
+FORMAT real fmt := $g(0,3)$;
+FORMAT real array fmt := $f(real fmt)", "$;
+FORMAT compl fmt := $f(real fmt)"⊥"f(real fmt)$;
+FORMAT compl array fmt := $f(compl fmt)", "$;
+
+test:(
+  []COMPL
+    tooth wave ft = fft((1, 1, 1, 1, 0, 0, 0, 0)),
+    one and a quarter wave ft = fft((0, 0.924, 0.707,-0.383,-1,-0.383, 0.707, 0.924,
+                                     0,-0.924,-0.707, 0.383, 1, 0.383,-0.707,-0.924));
+  printf((
+    $"Tooth wave: "$,compl array fmt, tooth wave ft, $l$,
+    $"1¼ cycle wave: "$, compl array fmt, one and a quarter wave ft, $l$
+  ))
+)

Task/Fast-Fourier-transform/Ada/fast-fourier-transform-1.ada

@@ -0,0 +1,7 @@
+with Ada.Numerics.Generic_Complex_Arrays;
+
+generic
+   with package Complex_Arrays is
+      new Ada.Numerics.Generic_Complex_Arrays (<>);
+   use Complex_Arrays;
+function Generic_FFT (X : Complex_Vector) return Complex_Vector;

Task/Fast-Fourier-transform/Ada/fast-fourier-transform-2.ada

@@ -0,0 +1,39 @@
+with Ada.Numerics;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+
+function Generic_FFT (X : Complex_Vector) return Complex_Vector is
+
+   package Complex_Elementary_Functions is
+      new Ada.Numerics.Generic_Complex_Elementary_Functions
+        (Complex_Arrays.Complex_Types);
+
+   use Ada.Numerics;
+   use Complex_Elementary_Functions;
+   use Complex_Arrays.Complex_Types;
+
+   function FFT (X : Complex_Vector; N, S : Positive)
+      return Complex_Vector is
+   begin
+      if N = 1 then
+         return (1..1 => X (X'First));
+      else
+         declare
+            F : constant Complex  := exp (Pi * j / Real_Arrays.Real (N/2));
+            Even : Complex_Vector := FFT (X, N/2, 2*S);
+            Odd  : Complex_Vector := FFT (X (X'First + S..X'Last), N/2, 2*S);
+         begin
+            for K in 0..N/2 - 1 loop
+               declare
+                  T : constant Complex := Odd (Odd'First + K) / F ** K;
+               begin
+                  Odd  (Odd'First  + K) := Even (Even'First + K) - T;
+                  Even (Even'First + K) := Even (Even'First + K) + T;
+               end;
+            end loop;
+            return Even & Odd;
+         end;
+      end if;
+   end FFT;
+begin
+   return FFT (X, X'Length, 1);
+end Generic_FFT;

Task/Fast-Fourier-transform/Ada/fast-fourier-transform-3.ada

@@ -0,0 +1,20 @@
+with Ada.Numerics.Complex_Arrays;  use Ada.Numerics.Complex_Arrays;
+with Ada.Complex_Text_IO;          use Ada.Complex_Text_IO;
+with Ada.Text_IO;                  use Ada.Text_IO;
+
+with Ada.Numerics.Complex_Elementary_Functions;
+with Generic_FFT;
+
+procedure Example is
+   function FFT is new Generic_FFT (Ada.Numerics.Complex_Arrays);
+   X : Complex_Vector := (1..4 => (1.0, 0.0), 5..8 => (0.0, 0.0));
+   Y : Complex_Vector := FFT (X);
+begin
+   Put_Line ("       X              FFT X ");
+   for I in Y'Range loop
+      Put (X (I - Y'First + X'First), Aft => 3, Exp => 0);
+      Put (" ");
+      Put (Y (I), Aft => 3, Exp => 0);
+      New_Line;
+   end loop;
+end;

Task/Fast-Fourier-transform/BBC-BASIC/fast-fourier-transform.bbc

@@ -0,0 +1,44 @@
+      @% = &60A
+
+      DIM Complex{r#, i#}
+      DIM in{(7)} = Complex{}, out{(7)} = Complex{}
+      DATA 1, 1, 1, 1, 0, 0, 0, 0
+
+      PRINT "Input (real, imag):"
+      FOR I% = 0 TO 7
+        READ in{(I%)}.r#
+        PRINT in{(I%)}.r# "," in{(I%)}.i#
+      NEXT
+
+      PROCfft(out{()}, in{()}, 0, 1, DIM(in{()},1)+1)
+
+      PRINT "Output (real, imag):"
+      FOR I% = 0 TO 7
+        PRINT out{(I%)}.r# "," out{(I%)}.i#
+      NEXT
+      END
+
+      DEF PROCfft(b{()}, o{()}, B%, S%, N%)
+      LOCAL I%, t{} : DIM t{} = Complex{}
+      IF S% < N% THEN
+        PROCfft(o{()}, b{()}, B%, S%*2, N%)
+        PROCfft(o{()}, b{()}, B%+S%, S%*2, N%)
+        FOR I% = 0 TO N%-1 STEP 2*S%
+          t.r# = COS(-PI*I%/N%)
+          t.i# = SIN(-PI*I%/N%)
+          PROCcmul(t{}, o{(B%+I%+S%)})
+          b{(B%+I% DIV 2)}.r# = o{(B%+I%)}.r# + t.r#
+          b{(B%+I% DIV 2)}.i# = o{(B%+I%)}.i# + t.i#
+          b{(B%+(I%+N%) DIV 2)}.r# = o{(B%+I%)}.r# - t.r#
+          b{(B%+(I%+N%) DIV 2)}.i# = o{(B%+I%)}.i# - t.i#
+        NEXT
+      ENDIF
+      ENDPROC
+
+      DEF PROCcmul(c{},d{})
+      LOCAL r#, i#
+      r# = c.r#*d.r# - c.i#*d.i#
+      i# = c.r#*d.i# + c.i#*d.r#
+      c.r# = r#
+      c.i# = i#
+      ENDPROC

Task/Fast-Fourier-transform/C++/fast-fourier-transform.cpp

@@ -0,0 +1,45 @@
+#include <complex>
+#include <iostream>
+#include <valarray>
+
+const double PI = 3.141592653589793238460;
+
+typedef std::complex<double> Complex;
+typedef std::valarray<Complex> CArray;
+
+// Cooley–Tukey FFT (in-place)
+void fft(CArray& x)
+{
+    const size_t N = x.size();
+    if (N <= 1) return;
+
+    // divide
+    CArray even = x[std::slice(0, N/2, 2)];
+    CArray  odd = x[std::slice(1, N/2, 2)];
+
+    // conquer
+    fft(even);
+    fft(odd);
+
+    // combine
+    for (size_t k = 0; k < N/2; ++k)
+    {
+        Complex t = std::polar(1.0, -2 * PI * k / N) * odd[k];
+        x[k    ] = even[k] + t;
+        x[k+N/2] = even[k] - t;
+    }
+}
+
+int main()
+{
+    const Complex test[] = { 1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0 };
+    CArray data(test, 8);
+
+    fft(data);
+
+    for (int i = 0; i < 8; ++i)
+    {
+        std::cout << data[i] << "\n";
+    }
+    return 0;
+}

Task/Fast-Fourier-transform/C/fast-fourier-transform-1.c

@@ -0,0 +1,49 @@
+#include <stdio.h>
+#include <math.h>
+#include <complex.h>
+
+double PI;
+typedef double complex cplx;
+
+void _fft(cplx buf[], cplx out[], int n, int step)
+{
+	if (step < n) {
+		_fft(out, buf, n, step * 2);
+		_fft(out + step, buf + step, n, step * 2);
+
+		for (int i = 0; i < n; i += 2 * step) {
+			cplx t = cexp(-I * PI * i / n) * out[i + step];
+			buf[i / 2]     = out[i] + t;
+			buf[(i + n)/2] = out[i] - t;
+		}
+	}
+}
+
+void fft(cplx buf[], int n)
+{
+	cplx out[n];
+	for (int i = 0; i < n; i++) out[i] = buf[i];
+
+	_fft(buf, out, n, 1);
+}
+
+int main()
+{
+	PI = atan2(1, 1) * 4;
+	cplx buf[] = {1, 1, 1, 1, 0, 0, 0, 0};
+
+	void show(const char * s) {
+		printf("%s", s);
+		for (int i = 0; i < 8; i++)
+			if (!cimag(buf[i]))
+				printf("%g ", creal(buf[i]));
+			else
+				printf("(%g, %g) ", creal(buf[i]), cimag(buf[i]));
+	}
+
+	show("Data: ");
+	fft(buf, 8);
+	show("\nFFT : ");
+
+	return 0;
+}

Task/Fast-Fourier-transform/C/fast-fourier-transform-2.c

@@ -0,0 +1,2 @@
+Data: 1 1 1 1 0 0 0 0
+FFT : 4 (1, -2.41421) 0 (1, -0.414214) 0 (1, 0.414214) 0 (1, 2.41421)

Task/Fast-Fourier-transform/D/fast-fourier-transform-1.d

@@ -0,0 +1,15 @@
+import std.stdio, std.math, std.algorithm, std.range;
+
+/*auto*/ creal[] fft(/*in*/ creal[] x) /*pure nothrow*/ {
+    int N = x.length;
+    if (N <= 1) return x;
+    auto ev = stride(x, 2).array().fft();
+    auto od = stride(x[1 .. $], 2).array().fft();
+    auto l = map!(k => ev[k] + expi(-2*PI*k/N) * od[k])(iota(N / 2));
+    auto r = map!(k => ev[k] - expi(-2*PI*k/N) * od[k])(iota(N / 2));
+    return l.chain(r).array();
+}
+
+void main() {
+    writeln(fft([1.0L+0i, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0]));
+}

Task/Fast-Fourier-transform/D/fast-fourier-transform-2.d

@@ -0,0 +1,19 @@
+import std.stdio, std.math, std.algorithm, std.range, std.complex;
+
+auto fft(Complex!real[] x)
+{
+    ulong N = x.length;
+    if (N <= 1) { return x; }
+    auto ev = stride(x, 2).array.fft;
+    auto od = stride(x[1 .. $], 2).array.fft;
+    auto l = map!(k => ev[k] + std.complex.expi(-2*PI*k/N) * od[k])(iota(N / 2));
+    auto r = map!(k => ev[k] - std.complex.expi(-2*PI*k/N) * od[k])(iota(N / 2));
+    return l.chain(r).array;
+}
+
+void main()
+{
+    // map produces range, .array converts range to array
+    auto data = [1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0].map!(a => Complex!real(a, 0)).array;
+    data.fft.writeln;
+}

Task/Fast-Fourier-transform/D/fast-fourier-transform-3.d

@@ -0,0 +1,5 @@
+import std.stdio   : writeln;
+import std.numeric : fft;
+void main() {
+    [1.0, 1.0, 1.0, 1.0, 0, 0, 0, 0].fft.writeln;
+}

Task/Fast-Fourier-transform/Fortran/fast-fourier-transform.f

@@ -0,0 +1,60 @@
+module fft_mod
+  implicit none
+  integer,       parameter :: dp=selected_real_kind(15,300)
+  real(kind=dp), parameter :: pi=3.141592653589793238460_dp
+contains
+
+  ! In place Cooley-Tukey FFT
+  recursive subroutine fft(x)
+    complex(kind=dp), dimension(:), intent(inout)  :: x
+    complex(kind=dp)                               :: t
+    integer                                        :: N
+    integer                                        :: i
+    complex(kind=dp), dimension(:), allocatable    :: even, odd
+
+    N=size(x)
+
+    if(n.le.1) return
+
+    allocate(odd((N+1)/2))
+    allocate(even(N/2))
+
+    ! divide
+    odd =x(1:N:2)
+    even=x(2:N:2)
+
+    ! conquer
+    call fft(odd)
+    call fft(even)
+
+    ! combine
+    do i=1,N/2
+
+
+t=exp(cmplx(0.0_dp,-2.0_dp*pi*real(i-1,dp)/real(N,dp),KIND=DP))*even(i)
+       x(i)     = odd(i) + t
+       x(i+N/2) = odd(i) - t
+    end do
+
+    deallocate(odd)
+    deallocate(even)
+
+  end subroutine fft
+
+end module fft_mod
+
+program test
+  use fft_mod
+  implicit none
+  complex(kind=dp), dimension(8) :: data = (/1.0, 1.0, 1.0, 1.0, 0.0,
+
+0.0, 0.0, 0.0/)
+  integer :: i
+
+  call fft(data)
+
+  do i=1,8
+     write(*,'("(", F20.15, ",", F20.15, "i )")') data(i)
+  end do
+
+end program test

Task/Fast-Fourier-transform/GAP/fast-fourier-transform.gap

@@ -0,0 +1,23 @@
+# Here an implementation with no optimization (O(n^2)).
+# In GAP, E(n) = exp(2*i*pi/n), a primitive root of the unity.
+
+Fourier := function(a)
+	local n, z;
+	n := Size(a);
+	z := E(n);
+	return List([0 .. n - 1], k -> Sum([0 .. n - 1], j -> a[j + 1]*z^(-k*j)));
+end;
+
+InverseFourier := function(a)
+	local n, z;
+	n := Size(a);
+	z := E(n);
+	return List([0 .. n - 1], k -> Sum([0 .. n - 1], j -> a[j + 1]*z^(k*j)))/n;
+end;
+
+Fourier([1, 1, 1, 1, 0, 0, 0, 0]);
+# [ 4, 1-E(8)-E(8)^2-E(8)^3, 0, 1-E(8)+E(8)^2-E(8)^3,
+#   0, 1+E(8)-E(8)^2+E(8)^3, 0, 1+E(8)+E(8)^2+E(8)^3 ]
+
+InverseFourier(last);
+# [ 1, 1, 1, 1, 0, 0, 0, 0 ]

Task/Fast-Fourier-transform/Go/fast-fourier-transform.go

@@ -0,0 +1,29 @@
+package main
+
+import (
+    "fmt"
+    "math"
+    "math/cmplx"
+)
+
+func ditfft2(x []float64, y []complex128, n, s int) {
+    if n == 1 {
+        y[0] = complex(x[0], 0)
+        return
+    }
+    ditfft2(x, y, n/2, 2*s)
+    ditfft2(x[s:], y[n/2:], n/2, 2*s)
+    for k := 0; k < n/2; k++ {
+        tf := cmplx.Rect(1, -2*math.Pi*float64(k)/float64(n)) * y[k+n/2]
+        y[k], y[k+n/2] = y[k]+tf, y[k]-tf
+    }
+}
+
+func main() {
+    x := []float64{1, 1, 1, 1, 0, 0, 0, 0}
+    y := make([]complex128, len(x))
+    ditfft2(x, y, len(x), 1)
+    for _, c := range y {
+        fmt.Printf("%8.4f\n", c)
+    }
+}

Task/Fast-Fourier-transform/Haskell/fast-fourier-transform.hs

@@ -0,0 +1,17 @@
+import Data.Complex
+
+-- Cooley-Tukey
+fft [] = []
+fft [x] = [x]
+fft xs = zipWith (+) ys ts ++ zipWith (-) ys ts
+    where n = length xs
+          ys = fft evens
+          zs = fft odds
+          (evens, odds) = split xs
+          split [] = ([], [])
+          split [x] = ([x], [])
+          split (x:y:xs) = (x:xt, y:yt) where (xt, yt) = split xs
+          ts = zipWith (\z k -> exp' k n * z) zs [0..]
+          exp' k n = cis $ -2 * pi * (fromIntegral k) / (fromIntegral n)
+
+main = mapM_ print $ fft [1,1,1,1,0,0,0,0]

Task/Fast-Fourier-transform/J/fast-fourier-transform-1.j

@@ -0,0 +1,4 @@
+cube  =: ($~ q:@#) :. ,
+rou   =: ^@j.@o.@(% #)@i.@-:  NB. roots of unity
+floop =: 4 : 'for_r. i.#$x do. (y=.{."1 y) ] x=.(+/x) ,&,:"r (-/x)*y end.'
+fft   =: ] floop&.cube rou@#

Task/Fast-Fourier-transform/J/fast-fourier-transform-2.j

@@ -0,0 +1,3 @@
+   (**+)&.+. (,: fft) 1 o. 2p1*3r16 * i.16
+0 0.92388 0.707107 0.382683 1 0.382683 0.707107 0.92388 0 0.92388 0.707107 0.382683 1 0.382683 0.707107 0.92388
+0       0        0      0j8 0        0        0       0 0       0        0        0 0      0j8        0       0

Task/Fast-Fourier-transform/J/fast-fourier-transform-3.j

@@ -0,0 +1,9 @@
+   Re=: {.@+.@fft
+   Im=: {:@+.@fft
+   M=: 4#1 0
+   M
+1 1 1 1 0 0 0 0
+   Re M
+4 1 0 1 0 1 0 1
+   Im M
+0 2.41421 0 0.414214 0 _0.414214 0 _2.41421

Task/Fast-Fourier-transform/Liberty-BASIC/fast-fourier-transform.liberty

@@ -0,0 +1,105 @@
+    P =8
+    S  =int( log( P) /log( 2) +0.9999)
+
+    Pi =3.14159265
+    R1 =2^S
+
+    R =R1 -1
+    R2 =div( R1,  2)
+    R4 =div( R1,  4)
+    R3 =R4 +R2
+
+    Dim Re( R1), Im( R1), Co( R3)
+
+    for N =0 to P -1
+        read dummy: Re( N) =dummy
+        read dummy: Im( N) =dummy
+    next N
+
+    data    1, 0,      1, 0,      1, 0,      1, 0,      0, 0,     0, 0,      0, 0,       0, 0
+
+    S2 =div( S, 2)
+    S1 =S -S2
+    P1 =2^S1
+    P2 =2^S2
+
+    dim V( P1 -1)
+    V( 0) =0
+    DV =1
+    DP =P1
+
+    for J =1 to S1
+        HA =div( DP, 2)
+        PT =P1 -HA
+        for I =HA to PT step DP
+            V( I) =V( I -HA) +DV
+        next I
+        DV =DV +DV
+        DP =HA
+    next J
+
+    K =2 *Pi /R1
+
+    for X =0 to R4
+        COX =cos( K *X)
+        Co( X) =COX
+        Co( R2 -X) =0 -COX
+        Co( R2 +X) =0 -COX
+    next X
+
+    print "FFT: bit reversal"
+
+    for I =0 to P1 -1
+        IP =I *P2
+        for J =0 to P2 -1
+            H =IP +J
+            G =V( J) *P2 +V( I)
+            if G >H then temp =Re( G): Re( G) =Re( H): Re( H) =temp
+            if G >H then temp =Im( G): Im( G) =Im( H): Im( H) =temp
+        next J
+    next I
+
+    T =1
+
+    for stage =0 to S -1
+        print "  Stage:- "; stage
+        D =div( R2, T)
+        for Z =0 to T -1
+            L   =D *Z
+            LS  =L +R4
+            for I =0 to D -1
+                A      =2 *I *T +Z
+                B      =A +T
+                F1     =Re( A)
+                F2     =Im( A)
+                P1     =Co( L)  *Re( B)
+                P2     =Co( LS) *Im( B)
+                P3     =Co( LS) *Re( B)
+                P4     =Co( L)  *Im( B)
+                Re( A) =F1 +P1 -P2
+                Im( A) =F2 +P3 +P4
+                Re( B) =F1 -P1 +P2
+                Im( B) =F2 -P3 -P4
+            next I
+        next Z
+        T =T +T
+    next stage
+
+    print "   M          Re( M)       Im( M)"
+
+    for M =0 to R
+        if abs( Re( M)) <10^-5 then Re( M) =0
+        if abs( Im( M)) <10^-5 then Im( M) =0
+        print "   "; M, Re( M), Im( M)
+    next M
+
+    end
+
+
+    wait
+
+    function div( a, b)
+        div =int( a /b)
+    end function
+
+    end

Task/Fast-Fourier-transform/MATLAB/fast-fourier-transform.m

@@ -0,0 +1 @@
+ fft([1,1,1,1,0,0,0,0]')

Task/Fast-Fourier-transform/Mathematica/fast-fourier-transform.mathematica

@@ -0,0 +1 @@
+Fourier[{1,1,1,1,0,0,0,0}, FourierParameters->{1,-1}]

Task/Fast-Fourier-transform/Maxima/fast-fourier-transform.maxima

@@ -0,0 +1,3 @@
+load(fft)$
+fft([1, 2, 3, 4]);
+[2.5, -0.5 * %i - 0.5, -0.5, 0.5 * %i - 0.5]

Task/Fast-Fourier-transform/PicoLisp/fast-fourier-transform-1.l

@@ -0,0 +1,20 @@
+# apt-get install libfftw3-dev
+
+(scl 4)
+
+(de FFTW_FORWARD . -1)
+(de FFTW_ESTIMATE . 64)
+
+(de fft (Lst)
+   (let
+      (Len (length Lst)
+         In (native "libfftw3.so" "fftw_malloc" 'N (* Len 16))
+         Out (native "libfftw3.so" "fftw_malloc" 'N (* Len 16))
+         P (native "libfftw3.so" "fftw_plan_dft_1d" 'N
+            Len In Out FFTW_FORWARD FFTW_ESTIMATE ) )
+      (struct In NIL (cons 1.0 (apply append Lst)))
+      (native "libfftw3.so" "fftw_execute" NIL P)
+      (prog1 (struct Out (make (do Len (link (1.0 . 2)))))
+         (native "libfftw3.so" "fftw_destroy_plan" NIL P)
+         (native "libfftw3.so" "fftw_free" NIL Out)
+         (native "libfftw3.so" "fftw_free" NIL In) ) ) )

Task/Fast-Fourier-transform/PicoLisp/fast-fourier-transform-2.l

@@ -0,0 +1,4 @@
+(for R (fft '((1.0 0) (1.0 0) (1.0 0) (1.0 0) (0 0) (0 0) (0 0) (0 0)))
+   (tab (6 8)
+      (round (car R))
+      (round (cadr R)) ) )

Task/Fast-Fourier-transform/Python/fast-fourier-transform-1.py

@@ -0,0 +1,11 @@
+from cmath import exp, pi
+
+def fft(x):
+    N = len(x)
+    if N <= 1: return x
+    even = fft(x[0::2])
+    odd =  fft(x[1::2])
+    return [even[k] + exp(-2j*pi*k/N)*odd[k] for k in xrange(N/2)] + \
+           [even[k] - exp(-2j*pi*k/N)*odd[k] for k in xrange(N/2)]
+
+print fft([1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0])

Task/Fast-Fourier-transform/Python/fast-fourier-transform-2.py

@@ -0,0 +1,5 @@
+>>> from numpy.fft import fft
+>>> from numpy import array
+>>> a = array((0.0, 0.924, 0.707, -0.383, -1.0, -0.383, 0.707, 0.924, 0.0, -0.924, -0.707, 0.383, 1.0, 0.383, -0.707, -0.924))
+>>> print( ' '.join("%5.3f" % abs(f) for f in fft(a)) )
+0.000 0.001 0.000 8.001 0.000 0.001 0.000 0.001 0.000 0.001 0.000 0.001 0.000 8.001 0.000 0.001

Task/Fast-Fourier-transform/R/fast-fourier-transform.r

@@ -0,0 +1 @@
+fft(c(1,1,1,1,0,0,0,0))

Task/Fast-Fourier-transform/REXX/fast-fourier-transform.rexx

@@ -0,0 +1,77 @@
+/*REXX pgm does a fast Fourier transform (FFT) on a set of complex nums.*/
+numeric digits 85
+arg data; if data='' then data='1 1 1 1 0'  /*no data?  Then use default*/
+data=translate(data, 'J', "I")         /*allow use of  i  as well as  j */
+size=words(data);    pad=left('',6)    /*PAD: for indenting/padding SAYs*/
+  do sig=0 until 2**sig>=size      ;end /* #  args exactly a power of 2?*/
+  do j=size+1 to 2**sig;data=data 0;end /*add zeroes until a power of 2.*/
+size=words(data);    call hdr          /*┌─────────────────────────────┐*/
+                                       /*│ Numbers in  data  can be in │*/
+  do j=0  for size                     /*│ 7 formats:   real           │*/
+  _=word(data,j+1)                     /*│              real,imag      │*/
+  parse var  _  #.1.j  ','  #.2.j      /*│                  ,imag      │*/
+  if right(#.1.j,1)=='J'    then       /*│                   nnnJ      │*/
+      parse var #.1.j #2.j "J" @.1.j   /*│                   nnnj      │*/
+    do p=1  for 2     /*omitted?*/     /*│                   nnnI      │*/
+    #.p.j=word(#.p.j 0, 1)             /*│                   nnni      │*/
+    end   /*p*/                        /*└─────────────────────────────┘*/
+  say pad " FFT   in "    center(j+1,7)  pad  nice(#.1.j)  nice(#.2.j,'i')
+  end     /*j*/
+
+say;             say;                       tran=2*pi()/2**sig;  !.=0
+hsig=2**sig%2;   counterA=2**(sig-sig%2);   pointer=counterA;    doubler=1
+
+  do sig-sig%2;  halfpointer=pointer%2
+            do i=halfpointer  by pointer  to counterA-halfpointer
+            _=i-halfpointer;  !.i=!._+doubler
+            end   /*i*/
+  doubler=doubler*2;  pointer=halfpointer
+  end   /*sig-sig%2*/
+
+         do j=0 to 2**sig%4; cmp.j=cos(j*tran);  _m=hsig-j;  cmp._m=-cmp.j
+                                                 _p=hsig+j;  cmp._p=-cmp.j
+         end  /*j*/
+
+counterB=2**(sig%2)
+
+  do i=0  for counterA;    p=i*counterB
+      do j=0 for counterB; h=p+j; _=!.j*counterB+!.i; if _<=h then iterate
+      parse value  #.1._ #.1.h #.2._ #.2.h   with  #.1.h #.1._ #.2.h #.2._
+      end   /*j*/                      /* [↓]  switch two sets of values*/
+  end       /*i*/
+
+double=1;       do sig               ;  w=2**sig%2%double
+                  do k=0  for double ;  lb=w*k           ; lh=lb+2**sig%4
+                    do j=0 for w     ;  a=j*double*2+k   ; b=a+double
+                    r=#.1.a; i=#.2.a ;  c1=cmp.lb*#.1.b  ; c4=cmp.lb*#.2.b
+                                        c2=cmp.lh*#.2.b  ; c3=cmp.lh*#.1.b
+                                        #.1.a=r+c1-c2    ; #.2.a=i+c3+c4
+                                        #.1.b=r-c1+c2    ; #.2.b=i-c3-c4
+                    end              /*j*/
+                  end                /*k*/
+                double=double+double
+                end                  /*sig*/
+call hdr
+        do i=0  for size
+        say pad " FFT  out " center(i+1,7) pad nice(#.1.i) nice(#.2.i,'j')
+        end   /*i*/
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────HDR subroutine──────────────────────*/
+hdr:  _='───data───   num       real-part      imaginary-part';  say pad _
+      say pad  translate(_, " "copies('═',256), " "xrange());    return
+/*──────────────────────────────────PI subroutine───────────────────────────────────*/
+pi: return ,                           /*add more digs   if   NUMERIC DIGITS > 85.  */
+3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628
+/*──────────────────────────────────R2R subroutine──────────────────────*/
+r2r:  return arg(1) // (2*pi())        /*reduce radians to unit circle. */
+/*──────────────────────────────────COS subroutine──────────────────────*/
+cos:  procedure;   parse arg x;    x=r2r(x);     return .sincos(1,1,-1)
+.sincos: parse arg z,_,i;   x=x*x;   p=z
+         do k=2 by 2; _=-_*x/(k*(k+i)); z=z+_; if z=p then leave; p=z; end
+         return z
+/*──────────────────────────────────NICE subroutine─────────────────────*/
+nice: procedure; parse arg x,j         /*makes complex nums look nicer. */
+numeric digits digits()%10;   nz='1e-'digits()    /*show ≈10% of DIGITS.*/
+if abs(x)<nz  then x=0;       x=x/1;       if x=0 & j\==''  then return ''
+x=format(x,,digits());        if pos('.',x)\==0  then x=strip(x,'T',0)
+x=strip(x,,'.');     if x>=0  then x=' '||x;  return left(x||j,digits()+4)

Task/Fast-Fourier-transform/Scala/fast-fourier-transform.scala

@@ -0,0 +1,32 @@
+object FFT extends App {
+  import scala.math._
+
+  case class Complex(re: Double, im: Double = 0.0) {
+    def +(x: Complex): Complex = Complex((this.re+x.re),(this.im+x.im))
+    def -(x: Complex): Complex = Complex((this.re-x.re),(this.im-x.im))
+    def *(x: Complex): Complex = Complex(this.re*x.re-this.im*x.im,this.re*x.im+this.im*x.re)
+  }
+
+  def fft(f: List[Complex]): List[Complex] = {
+    import Stream._
+    require((f.size==0)||(from(0) map {x=>pow(2,x).toInt}).takeWhile(_<2*f.size).toList.exists(_==f.size)==true,"list size "+f.size+" not allowed!")
+    f.size match {
+      case 0 => Nil
+      case 1 => f
+      case n => {
+        val cis: Double => Complex = phi => Complex(cos(phi),sin(phi))
+        val e = fft(f.zipWithIndex.filter(_._2%2==0).map(_._1))
+        val o  = fft(f.zipWithIndex.filter(_._2%2!=0).map(_._1))
+        import scala.collection.mutable.ListBuffer
+        val lb = new ListBuffer[Pair[Int, Complex]]()
+        for (k <- 0 to n/2-1) {
+          lb += Pair(k,e(k)+o(k)*cis(-2*Pi*k/n))
+          lb += Pair(k+n/2,e(k)-o(k)*cis(-2*Pi*k/n))
+        }
+        lb.toList.sortWith((x,y)=>x._1<y._1).map(_._2)
+      }
+    }
+  }
+
+  fft(List(Complex(1),Complex(1),Complex(1),Complex(1),Complex(0),Complex(0),Complex(0),Complex(0))).foreach(println)
+}

Task/Fast-Fourier-transform/Tcl/fast-fourier-transform.tcl

@@ -0,0 +1,38 @@
+package require math::constants
+package require math::fourier
+
+math::constants::constants pi
+# Helper functions
+proc wave {samples cycles} {
+    global pi
+    set wave {}
+    set factor [expr {2*$pi * $cycles / $samples}]
+    for {set i 0} {$i < $samples} {incr i} {
+	lappend wave [expr {sin($factor * $i)}]
+    }
+    return $wave
+}
+proc printwave {waveName {format "%7.3f"}} {
+    upvar 1 $waveName wave
+    set out [format "%-6s" ${waveName}:]
+    foreach value $wave {
+	append out [format $format $value]
+    }
+    puts $out
+}
+proc waveMagnitude {wave} {
+    set out {}
+    foreach value $wave {
+	lassign $value re im
+	lappend out [expr {hypot($re, $im)}]
+    }
+    return $out
+}
+
+set wave [wave 16 3]
+printwave wave
+# Uses FFT if input length is power of 2, and a less efficient algorithm otherwise
+set fft [math::fourier::dft $wave]
+# Convert to magnitudes for printing
+set fft2 [waveMagnitude $fft]
+printwave fft2