|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Ђ«ҐЄбҐ© Џ бҐзЁЄ 2:5020/400 23 May 2001 18:24:19
To : All
Subject : Re: FFT (быстрое преобразование Фурье)
--------------------------------------------------------------------------------
"Alex Tychinin" <Alex.Tychinin@p14.f154.n5020.z2.fidonet.org> сообщил...
> Он знает немного Бейсик
Option Explicit
' Attribute VB_Name = "VBFFT"
'--------------------------------------------------------------------
' VB FFT Release 1.0
' by Murphy McCauley (MurphyMc@Concentric.NET)
' 08/01/99
'--------------------------------------------------------------------
' This code is very, very heavily based on Don Cross's fourier.pas
' Turbo Pascal Unit for calculating the Fast Fourier Transform.
' I've not implemented all of his functions, though I may well do
' so in the future.
' For more info, you can contact me by email, check my website at:
' http://www.fullspectrum.com/deeth/
' or check Don Cross's FFT web page at:
' http://www.intersrv.com/~dcross/fft.html
' You also may be intrested in the FFT.DLL that I put together based
' on Don Cross's FFT C code. It's callable with Visual Basic and
' includes VB declares. You can get it from his website.
'--------------------------------------------------------------------
Const Pi = 3.14159265358979
Function NumberOfBitsNeeded(PowerOfTwo As Long) As Byte
Dim I As Byte
For I = 0 To 16
If (PowerOfTwo And (2 ^ I)) <> 0 Then
NumberOfBitsNeeded = I
Exit Function
End If
Next
End Function
Function IsPowerOfTwo(X As Long) As Boolean
If (X < 2) Then IsPowerOfTwo = False: Exit Function
If (X And (X - 1)) = False Then IsPowerOfTwo = True
End Function
Function ReverseBits(ByVal Index As Long, NumBits As Byte) As Long
Dim I As Byte, Rev As Long
For I = 0 To NumBits - 1
Rev = (Rev * 2) Or (Index And 1)
Index = Index \ 2
Next
ReverseBits = Rev
End Function
Sub FourierTransform(NumSamples As Long, RealIn() As Double, _
ImageIn() As Double, RealOut() As Double, _
ImagOut() As Double)
Dim AngleNumerator As Double: AngleNumerator = 2# * Pi
Dim NumBits As Byte, I As Long, j As Long, k As Long
Dim n As Long, BlockSize As Long, BlockEnd As Long
Dim DeltaAngle As Double, DeltaAr As Double
Dim Alpha As Double, Beta As Double
Dim TR As Double, TI As Double, AR As Double, AI As Double
If (IsPowerOfTwo(NumSamples) = False) Or (NumSamples < 2) Then
Call MsgBox("Error in procedure Fourier:" + vbCrLf + " _
NumSamples is " + CStr(NumSamples) + ", which is not a _
positive integer power of two.", , "Error!")
Exit Sub
End If
NumBits = NumberOfBitsNeeded(NumSamples)
For I = 0 To (NumSamples - 1)
j = ReverseBits(I, NumBits)
RealOut(j) = RealIn(I)
ImagOut(j) = ImageIn(I)
Next
BlockEnd = 1
BlockSize = 2
Do While BlockSize <= NumSamples
DeltaAngle = AngleNumerator / BlockSize
Alpha = Sin(0.5 * DeltaAngle)
Alpha = 2# * Alpha * Alpha
Beta = Sin(DeltaAngle)
I = 0
Do While I < NumSamples
AR = 1#
AI = 0#
j = I
For n = 0 To BlockEnd - 1
k = j + BlockEnd
TR = AR * RealOut(k) - AI * ImagOut(k)
TI = AI * RealOut(k) + AR * ImagOut(k)
RealOut(k) = RealOut(j) - TR
ImagOut(k) = ImagOut(j) - TI
RealOut(j) = RealOut(j) + TR
ImagOut(j) = ImagOut(j) + TI
DeltaAr = Alpha * AR + Beta * AI
AI = AI - (Alpha * AI - Beta * AR)
AR = AR - DeltaAr
j = j + 1
Next
I = I + BlockSize
Loop
BlockEnd = BlockSize
BlockSize = BlockSize * 2
Loop
End Sub
--- ifmail v.2.15dev5
* Origin: Demos online service (2:5020/400)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
Re: FFT (быстрое преобразование Фурье) 