steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor and clean up of math.fft

db4
Aaron Schaefer 2008-11-07 01:35:17 -05:00
parent 2bd1723cc1
commit 2fafae5013
1 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
extra/math/fft/fft.factor
View File

@ -1,15 +1,38 @@
! Fast Fourier Transform, copyright (C) 2007 Hans Schmid ! Copyright (c) 2007 Hans Schmid.
! http://dressguardmeister.blogspot.com/2007/01/fft.html ! See http://factorcode.org/license.txt for BSD license.
USING: arrays sequences math math.vectors math.constants USING: columns grouping kernel math math.constants math.functions math.vectors
math.functions kernel splitting grouping columns ; sequences ;
IN: math.fft IN: math.fft
! Fast Fourier Transform
<PRIVATE
: n^v ( n v -- w ) [ ^ ] with map ; : n^v ( n v -- w ) [ ^ ] with map ;
: omega ( n -- n' )
recip -2 pi i* * * exp ;
: twiddle ( seq -- seq )
dup length [ omega ] [ n^v ] bi v* ;
PRIVATE>
DEFER: fft
: two ( seq -- seq )
fft 2 v/n dup append ;
<PRIVATE
: even ( seq -- seq ) 2 group 0 <column> ; : even ( seq -- seq ) 2 group 0 <column> ;
: odd ( seq -- seq ) 2 group 1 <column> ; : odd ( seq -- seq ) 2 group 1 <column> ;
DEFER: fft
: two ( seq -- seq ) fft 2 v/n dup append ; : (fft) ( seq -- seq )
: omega ( n -- n' ) recip -2 pi i* * * exp ; [ odd two twiddle ] [ even two ] bi v+ ;
: twiddle ( seq -- seq ) dup length dup omega swap n^v v* ;
: (fft) ( seq -- seq ) dup odd two twiddle swap even two v+ ; PRIVATE>
: fft ( seq -- seq ) dup length 1 = [ (fft) ] unless ;
: fft ( seq -- seq )
dup length 1 = [ (fft) ] unless ;