September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -33,12 +33,14 @@ void fft(CArray& x)
|
|||
|
||||
// Cooley-Tukey FFT (in-place, breadth-first, decimation-in-frequency)
|
||||
// Better optimized but less intuitive
|
||||
// !!! Warning : in some cases this code make result different from not optimased version above (need to fix bug)
|
||||
// The bug is now fixed @2017/05/30
|
||||
void fft(CArray &x)
|
||||
{
|
||||
// DFT
|
||||
unsigned int N = x.size(), k = N, n;
|
||||
double thetaT = 3.14159265358979323846264338328L / N;
|
||||
Complex phiT = Complex(cos(thetaT), sin(thetaT)), T;
|
||||
Complex phiT = Complex(cos(thetaT), -sin(thetaT)), T;
|
||||
while (k > 1)
|
||||
{
|
||||
n = k;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
package fft
|
||||
|
||||
import java.lang.Math.*
|
||||
|
||||
class Complex(val re: Double, val im: Double) {
|
||||
|
|
@ -17,6 +15,6 @@ class Complex(val re: Double, val im: Double) {
|
|||
else -> a + " - " + b + 'i'
|
||||
}
|
||||
|
||||
private final val a = "%1.3f".format(re)
|
||||
private final val b = "%1.3f".format(abs(im))
|
||||
private val a = "%1.3f".format(re)
|
||||
private val b = "%1.3f".format(abs(im))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
package fft
|
||||
|
||||
object FFT {
|
||||
fun fft(a: Array<Complex>) = _fft(a, Complex(0.0, 2.0), 1.0)
|
||||
fun rfft(a: Array<Complex>) = _fft(a, Complex(0.0, -2.0), 2.0)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
package fft
|
||||
|
||||
fun Array<*>.println() = println(joinToString(prefix = "[", postfix = "]"))
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
|
|
|
|||
118
Task/Fast-Fourier-transform/OoRexx/fast-fourier-transform.rexx
Normal file
118
Task/Fast-Fourier-transform/OoRexx/fast-fourier-transform.rexx
Normal file
|
|
@ -0,0 +1,118 @@
|
|||
Numeric Digits 16
|
||||
list='1 1 1 1 0 0 0 0'
|
||||
n=words(list)
|
||||
x=.array~new(n)
|
||||
Do i=1 To n
|
||||
x[i]=.complex~new(word(list,i),0)
|
||||
End
|
||||
Call show 'FFT in',x
|
||||
call fft x
|
||||
Call show 'FFT out',x
|
||||
Exit
|
||||
|
||||
show: Procedure
|
||||
Use Arg data,x
|
||||
Say '---data--- num real-part imaginary-part'
|
||||
Say '---------- --- --------- --------------'
|
||||
Do i=1 To x~size
|
||||
say data right(i,7)' ' x[i]~string
|
||||
End
|
||||
Return
|
||||
|
||||
fft: Procedure
|
||||
Use Arg in
|
||||
Numeric Digits 16
|
||||
n=in~size
|
||||
If n=1 Then Return
|
||||
odd=.array~new(n/2)
|
||||
even=.array~new(n/2)
|
||||
Do j=1 To n By 2; odd[(j+1)/2]=in[j]; End
|
||||
Do j=2 To n By 2; even[j/2]=in[j]; End
|
||||
Call fft odd
|
||||
Call fft even
|
||||
pi=3.14159265358979323E0
|
||||
n_2=n/2
|
||||
Do i=1 To n_2
|
||||
w=-2*pi*(i-1)/N
|
||||
t=.complex~new(rxCalcCos(w,,'R'),rxCalcSin(w,,'R'))*even[i]
|
||||
in[i]=odd[i]+t
|
||||
in[i+n_2]=odd[i]-t
|
||||
End
|
||||
Return
|
||||
|
||||
::class complex
|
||||
::method init
|
||||
expose r i
|
||||
use strict arg r, i = 0
|
||||
|
||||
-- complex instances are immutable, so these are
|
||||
-- read only attributes
|
||||
::attribute r GET
|
||||
::attribute i GET
|
||||
|
||||
::method add
|
||||
expose r i
|
||||
Numeric Digits 16
|
||||
use strict arg other
|
||||
if other~isa(.complex) then
|
||||
return self~class~new(r + other~r, i + other~i)
|
||||
else return self~class~new(r + other, i)
|
||||
|
||||
::method subtract
|
||||
expose r i
|
||||
Numeric Digits 16
|
||||
use strict arg other
|
||||
if other~isa(.complex) then
|
||||
return self~class~new(r - other~r, i - other~i)
|
||||
else return self~class~new(r - other, i)
|
||||
|
||||
::method "+"
|
||||
Numeric Digits 16
|
||||
-- need to check if this is a prefix plus or an addition
|
||||
if arg() == 0 then
|
||||
return self -- we can return this copy since it is immutable
|
||||
else
|
||||
forward message("ADD")
|
||||
|
||||
::method "-"
|
||||
Numeric Digits 16
|
||||
-- need to check if this is a prefix minus or a subtract
|
||||
if arg() == 0 then
|
||||
forward message("NEGATIVE")
|
||||
else
|
||||
forward message("SUBTRACT")
|
||||
|
||||
::method times
|
||||
expose r i
|
||||
Numeric Digits 16
|
||||
use strict arg other
|
||||
if other~isa(.complex) then
|
||||
return self~class~new(r * other~r - i * other~i, r * other~i + i * other~r)
|
||||
else return self~class~new(r * other, i * other)
|
||||
|
||||
::method "*"
|
||||
Numeric Digits 16
|
||||
forward message("TIMES")
|
||||
|
||||
::method string
|
||||
expose r i
|
||||
Numeric Digits 12
|
||||
Select
|
||||
When i=0 Then
|
||||
If r=0 Then
|
||||
Return '0'
|
||||
Else
|
||||
Return format(r,1,9)
|
||||
When i>0 Then
|
||||
Return format(r,1,9)' +'format(i,1,9)'i'
|
||||
Otherwise
|
||||
Return format(r,1,9)' -'format(abs(i),1,9)'i'
|
||||
End
|
||||
|
||||
::method formatnumber private
|
||||
use arg value
|
||||
Numeric Digits 16
|
||||
if value > 0 then return "+" value
|
||||
else return "-" value~abs
|
||||
|
||||
::requires rxMath library
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
sub fft {
|
||||
return @_ if @_ == 1;
|
||||
my @evn = fft( @_[0, 2 ... *] );
|
||||
my @odd = fft( @_[1, 3 ... *] ) Z*
|
||||
map &cis, (0, -tau / @_ ... *);
|
||||
return flat @evn »+« @odd, @evn »-« @odd;
|
||||
}
|
||||
|
||||
.say for fft <1 1 1 1 0 0 0 0>;
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
sub fft {
|
||||
@_ == 1 ?? @_ !!
|
||||
fft(@_[0,2...*]) «+«
|
||||
fft(@_[1,3...*]) «*« map &cis, (0,-τ/@_...^-τ)
|
||||
}
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
sub fft {
|
||||
use TrigPi;
|
||||
@_ == 1 ?? @_ !!
|
||||
fft(@_[0,2...*]) «+«
|
||||
fft(@_[1,3...*]) «*« map &cisPi, (0,-2/@_...^-2)
|
||||
}
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
sub fft {
|
||||
return @_ if @_ == 1;
|
||||
my @evn = fft( @_[0, 2 ... *] );
|
||||
my @odd = fft( @_[1, 3 ... *] ) Z*
|
||||
map &cis, (0, tau / @_ ... *);
|
||||
return flat @evn »+« @odd, @evn »-« @odd;
|
||||
}
|
||||
|
||||
my @seq = ^16;
|
||||
my $cycles = 3;
|
||||
my @wave = map { sin( tau * $_ / @seq * $cycles ) }, @seq;
|
||||
say "wave: ", @wave.fmt("%7.3f");
|
||||
|
||||
say "fft: ", fft(@wave)».abs.fmt("%7.3f");
|
||||
|
|
@ -13,10 +13,4 @@ sub fft {
|
|||
(map { $evn[$_] - $odd[$_] } 0 .. $#evn );
|
||||
}
|
||||
|
||||
|
||||
my @seq = 0 .. 15;
|
||||
my $cycles = 3;
|
||||
my @wave = map { sin( $_ * 2*pi/ @seq * $cycles ) } @seq;
|
||||
print "wave: ", join " ", map { sprintf "%7.3f", $_ } @wave;
|
||||
print "\n";
|
||||
print "fft: ", join " ", map { sprintf "%7.3f", abs $_ } fft(@wave);
|
||||
print "$_\n" for fft qw(1 1 1 1 0 0 0 0);
|
||||
|
|
|
|||
129
Task/Fast-Fourier-transform/Phix/fast-fourier-transform.phix
Normal file
129
Task/Fast-Fourier-transform/Phix/fast-fourier-transform.phix
Normal file
|
|
@ -0,0 +1,129 @@
|
|||
--
|
||||
-- demo\rosetta\FastFourierTransform.exw
|
||||
-- =====================================
|
||||
--
|
||||
-- Originally written by Robert Craig and posted to EuForum Dec 13, 2001
|
||||
--
|
||||
|
||||
constant REAL = 1, IMAG = 2
|
||||
|
||||
type complex(sequence x)
|
||||
return length(x)=2 and atom(x[REAL]) and atom(x[IMAG])
|
||||
end type
|
||||
|
||||
function p2round(integer x)
|
||||
-- rounds x up to a power of two
|
||||
integer p = 1
|
||||
while p<x do
|
||||
p += p
|
||||
end while
|
||||
return p
|
||||
end function
|
||||
|
||||
function log2(atom x)
|
||||
-- return log2 of x, or -1 if x is not a power of 2
|
||||
if x>0 then
|
||||
integer p = -1
|
||||
while floor(x)=x do
|
||||
x /= 2
|
||||
p += 1
|
||||
end while
|
||||
if x=0.5 then
|
||||
return p
|
||||
end if
|
||||
end if
|
||||
return -1
|
||||
end function
|
||||
|
||||
function bitrev(sequence a)
|
||||
-- bitrev an array of complex numbers
|
||||
integer j=1, n = length(a)
|
||||
for i=1 to n-1 do
|
||||
if i<j then
|
||||
{a[i],a[j]} = {a[j],a[i]}
|
||||
end if
|
||||
integer k = n/2
|
||||
while k<j do
|
||||
j -= k
|
||||
k /= 2
|
||||
end while
|
||||
j = j+k
|
||||
end for
|
||||
return a
|
||||
end function
|
||||
|
||||
function cmult(complex arg1, complex arg2)
|
||||
-- complex multiply
|
||||
return {arg1[REAL]*arg2[REAL]-arg1[IMAG]*arg2[IMAG],
|
||||
arg1[REAL]*arg2[IMAG]+arg1[IMAG]*arg2[REAL]}
|
||||
end function
|
||||
|
||||
function ip_fft(sequence a)
|
||||
-- perform an in-place fft on an array of complex numbers
|
||||
-- that has already been bit reversed
|
||||
integer n = length(a)
|
||||
integer ip, le, le1
|
||||
complex u, w, t
|
||||
|
||||
for l=1 to log2(n) do
|
||||
le = power(2, l)
|
||||
le1 = le/2
|
||||
u = {1, 0}
|
||||
w = {cos(PI/le1), sin(PI/le1)}
|
||||
for j=1 to le1 do
|
||||
for i=j to n by le do
|
||||
ip = i+le1
|
||||
t = cmult(a[ip], u)
|
||||
a[ip] = sq_sub(a[i],t)
|
||||
a[i] = sq_add(a[i],t)
|
||||
end for
|
||||
u = cmult(u, w)
|
||||
end for
|
||||
end for
|
||||
return a
|
||||
end function
|
||||
|
||||
function fft(sequence a)
|
||||
integer n = length(a)
|
||||
if log2(n)=-1 then
|
||||
puts(1, "input vector length is not a power of two, padded with 0's\n\n")
|
||||
n = p2round(n)
|
||||
-- pad with 0's
|
||||
for j=length(a)+1 to n do
|
||||
a = append(a,{0, 0})
|
||||
end for
|
||||
end if
|
||||
a = ip_fft(bitrev(a))
|
||||
-- reverse output from fft to switch +ve and -ve frequencies
|
||||
for i=2 to n/2 do
|
||||
integer j = n+2-i
|
||||
{a[i],a[j]} = {a[j],a[i]}
|
||||
end for
|
||||
return a
|
||||
end function
|
||||
|
||||
function ifft(sequence a)
|
||||
integer n = length(a)
|
||||
if log2(n)=-1 then ?9/0 end if -- (or as above?)
|
||||
a = ip_fft(bitrev(a))
|
||||
-- modifies results to get inverse fft
|
||||
for i=1 to n do
|
||||
a[i] = sq_div(a[i],n)
|
||||
end for
|
||||
return a
|
||||
end function
|
||||
|
||||
constant a = {{1, 0},
|
||||
{1, 0},
|
||||
{1, 0},
|
||||
{1, 0},
|
||||
{0, 0},
|
||||
{0, 0},
|
||||
{0, 0},
|
||||
{0, 0}}
|
||||
|
||||
printf(1, "Results of %d-point fft:\n\n", length(a))
|
||||
ppOpt({pp_Nest,1,pp_IntFmt,"%10.6f",pp_FltFmt,"%10.6f"})
|
||||
pp(fft(a))
|
||||
printf(1, "\nResults of %d-point inverse fft (rounded to 6 d.p.):\n\n", length(a))
|
||||
pp(ifft(fft(a)))
|
||||
|
|
@ -2,13 +2,13 @@
|
|||
numeric digits length( pi() ) - 1 /*limited by the PI function result. */
|
||||
arg data /*ARG verb uppercases the DATA from CL.*/
|
||||
if data='' then data=1 1 1 1 0 /*Not specified? Then use the default.*/
|
||||
size=words(data); pad=left('',6) /*PAD: for indenting and padding SAYs.*/
|
||||
do p=0 until 2**p>=size ; end /*number of args exactly a power of 2? */
|
||||
do j=size+1 to 2**p;data=data 0; end /*add zeroes to DATA 'til a power of 2.*/
|
||||
size=words(data); ph=p%2; call hdr /*╔═══════════════════════════╗*/
|
||||
size=words(data); pad=left('', 6) /*PAD: for indenting and padding SAYs.*/
|
||||
do p=0 until 2**p>=size ; end /*number of args exactly a power of 2? */
|
||||
do j=size+1 to 2**p; data=data 0; end /*add zeroes to DATA 'til a power of 2.*/
|
||||
size=words(data); ph=p%2 ; call hdr /*╔═══════════════════════════╗*/
|
||||
/* [↓] TRANSLATE allows I & J*/ /*║ Numbers in data can be in ║*/
|
||||
do j=0 for size /*║ seven formats: real ║*/
|
||||
_=translate( word(data,j+1), 'J', "I") /*║ real,imag ║*/
|
||||
_=translate( word(data, j+1), 'J', "I") /*║ real,imag ║*/
|
||||
parse var _ #.1.j '' $ 1 "," #.2.j /*║ ,imag ║*/
|
||||
if $=='J' then parse var #.1.j #2.j "J" #.1.j /*║ nnnJ ║*/
|
||||
/*║ nnnj ║*/
|
||||
|
|
@ -18,52 +18,51 @@ size=words(data); ph=p%2; call hdr /*╔══════
|
|||
say pad ' FFT in ' center(j+1, 7) pad fmt(#.1.j) fmt(#.2.j, "i")
|
||||
end /*j*/
|
||||
say
|
||||
tran=pi()*2 / 2**p; !.=0; hp=2**p %2; A=2**(p-ph); ptr=A; dbl=1
|
||||
tran=pi()*2 / 2**p; !.=0; hp=2**p %2; A=2**(p-ph); ptr=A; dbl=1
|
||||
say
|
||||
do p-ph; halfPtr=ptr%2
|
||||
do i=halfPtr by ptr to A-halfPtr; _=i-halfPtr; !.i=!._+dbl
|
||||
end /*i*/
|
||||
dbl=dbl*2; ptr=halfPtr
|
||||
do p-ph; halfPtr=ptr % 2
|
||||
do i=halfPtr by ptr to A-halfPtr; _=i - halfPtr; !.i=!._ + dbl
|
||||
end /*i*/
|
||||
ptr=halfPtr; dbl=dbl+dbl
|
||||
end /*p-ph*/
|
||||
|
||||
do j=0 to 2**p%4; cmp.j=cos(j*tran); _=hp - j; cmp._= -cmp.j
|
||||
_=hp + j; cmp._= -cmp.j
|
||||
do j=0 to 2**p%4; cmp.j=cos(j*tran); _=hp - j; cmp._= -cmp.j
|
||||
_=hp + j; cmp._= -cmp.j
|
||||
end /*j*/
|
||||
B=2**ph
|
||||
do i=0 for A; q=i * B
|
||||
do j=0 for B; h=q+j; _=!.j*B+!.i; if _<=h then iterate
|
||||
parse value #.1._ #.1.h #.2._ #.2.h with #.1.h #.1._ #.2.h #.2._
|
||||
do i=0 for A; q=i * B
|
||||
do j=0 for B; h=q+j; _=!.j*B+!.i; if _<=h then iterate
|
||||
parse value #.1._ #.1.h #.2._ #.2.h with #.1.h #.1._ #.2.h #.2._
|
||||
end /*j*/ /* [↑] swap two sets of values. */
|
||||
end /*i*/
|
||||
dbl=1
|
||||
do p ; w=hp % dbl
|
||||
do k=0 for dbl ; Lb=w * k ; Lh=Lb + 2**p % 4
|
||||
do j=0 for w ; a=j * dbl * 2 + k ; b= a + dbl
|
||||
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
|
||||
do p ; w= hp % dbl
|
||||
do k=0 for dbl ; Lb= w * k ; Lh= Lb + 2**p % 4
|
||||
do j=0 for w ; a= j * dbl * 2 + k ; b= a + dbl
|
||||
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*/
|
||||
dbl=dbl+dbl
|
||||
end /*p*/
|
||||
call hdr
|
||||
do i=0 for size
|
||||
say pad " FFT out " center(i+1,7) pad fmt(#.1.i) fmt(#.2.i,'j')
|
||||
say pad " FFT out " center(i+1,7) pad fmt(#.1.i) fmt(#.2.i,'j')
|
||||
end /*i*/ /*[↑] #s are shown with 10 decimal digs*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
cos: procedure; parse arg x; q=r2r(x)**2; z=1; _=1; p=1 /*bare bones COS. */
|
||||
do k=2 by 2; _=-_*q/(k*(k-1)); z=z+_; if z=p then leave; p=z; end; return z
|
||||
do k=2 by 2; _=-_*q/(k*(k-1)); z=z+_; if z=p then return z; p=z; end /*k*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
fmt: procedure; parse arg y,j; y=y/1 /*prettifies complex numbers for show. */
|
||||
if abs(y) < '1e-'digits()%4 then y=0; if y=0 & j\=='' then return ''
|
||||
y=format(y, , 10); if pos(.,y)\==0 then y=strip(y, 'T', 0)
|
||||
y=strip(y, , .); if y>=0 then y=' 'y; return left(y || j, 12)
|
||||
fmt: procedure; parse arg y,j; y=y/1 /*prettifies complex numbers for output*/
|
||||
if abs(y) < '1e-'digits()%4 then y=0; if y=0 & j\=='' then return ''
|
||||
y=format(y, , 10); if pos(.,y)\==0 then y=strip(y, 'T', 0)
|
||||
y=strip(y, , .); if y>=0 then y=' 'y; return left(y || j, 12)
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
hdr: _='───data─── num real─part imaginary─part'; say pad _
|
||||
say pad translate(_, " "copies('═',256), " "xrange()); return
|
||||
hdr: _= '───data─── num real─part imaginary─part'; say pad _
|
||||
say pad translate(_, " "copies('═', 256), " "xrange()); return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
pi: return 3.1415926535897932384626433832795028841971693993751058209749445923078164062862
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
r2r: return arg(1) // ( pi()*2 ) /*reduce the radians to a unit circle. */
|
||||
r2r: return arg(1) // ( pi()*2 ) /*reduce the radians to a unit circle. */
|
||||
|
|
|
|||
|
|
@ -1,3 +0,0 @@
|
|||
#lang racket
|
||||
(require math)
|
||||
(array-fft (array #[1. 1. 1. 1. 0. 0. 0. 0.]))
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
(fcarray
|
||||
#[4.0+0.0i
|
||||
1.0-2.414213562373095i
|
||||
0.0+0.0i
|
||||
1.0-0.4142135623730949i
|
||||
0.0+0.0i
|
||||
0.9999999999999999+0.4142135623730949i
|
||||
0.0+0.0i
|
||||
0.9999999999999997+2.414213562373095i])
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
. mata
|
||||
: a=1,2,3,4
|
||||
: fft(a)
|
||||
1 2 3 4
|
||||
+-----------------------------------------+
|
||||
1 | 10 -2 - 2i -2 -2 + 2i |
|
||||
+-----------------------------------------+
|
||||
: end
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
var [const] GSL=Import("zklGSL"); // libGSL (GNU Scientific Library)
|
||||
v:=GSL.ZVector(8).set(1,1,1,1);
|
||||
GSL.FFT(v).toList().concat("\n").println(); // in place
|
||||
Loading…
Add table
Add a link
Reference in a new issue