Refactor and clean up of math.fft
parent
2bd1723cc1
commit
2fafae5013
|
@ -1,15 +1,38 @@
|
|||
! Fast Fourier Transform, copyright (C) 2007 Hans Schmid
|
||||
! http://dressguardmeister.blogspot.com/2007/01/fft.html
|
||||
USING: arrays sequences math math.vectors math.constants
|
||||
math.functions kernel splitting grouping columns ;
|
||||
! Copyright (c) 2007 Hans Schmid.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: columns grouping kernel math math.constants math.functions math.vectors
|
||||
sequences ;
|
||||
IN: math.fft
|
||||
|
||||
! Fast Fourier Transform
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: 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> ;
|
||||
: odd ( seq -- seq ) 2 group 1 <column> ;
|
||||
DEFER: fft
|
||||
: two ( seq -- seq ) fft 2 v/n dup append ;
|
||||
: omega ( n -- n' ) recip -2 pi i* * * exp ;
|
||||
: twiddle ( seq -- seq ) dup length dup omega swap n^v v* ;
|
||||
: (fft) ( seq -- seq ) dup odd two twiddle swap even two v+ ;
|
||||
: fft ( seq -- seq ) dup length 1 = [ (fft) ] unless ;
|
||||
|
||||
: (fft) ( seq -- seq )
|
||||
[ odd two twiddle ] [ even two ] bi v+ ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: fft ( seq -- seq )
|
||||
dup length 1 = [ (fft) ] unless ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue