标题:这个倒序和蝶形算法vb程序如何运行?
只看楼主
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
结帖率:100%
 问题点数:0 回复次数:89 
这个倒序和蝶形算法vb程序如何运行?
Sub 倒序(X_() As Double)
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = UBound(X_) '求数组大小,其值必须是2的幂
lh = n / 2
j = n / 2
For i = 1 To n - 2
If i < j Then '倒序
t = X_(j)
X_(j) = X_(i)
X_(i) = t
End If

Debug.Print i, j
k = lh '下面是向右进位算法
Do
If k > j Then Exit Do '高位是1吗
j = j - k '是的,高位置0
k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
j = j + k '非则若最高位是0,则置1
Next

End Sub

蝶形算法代码
Sub 蝶形算法(xr() As Double)
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double
Dim xi()
n = UBound(xr) '求数组大小,其值必须是2的幂
m = 0
l = 2
pi = 3.14159265358979
Do
 l = l + l
 m = m + 1
 Loop Until l > n
 n = l / 2
ReDim xi(n - 1)

l = 1
Do
  le = 2 ^ l
  le1 = le / 2
  wr = 1
  wi = 0
  w1r = Cos(t)
  w1i = -Sin(t)
  r = 0
Do
  p = r
  Do
   q = p + le1
   
   tr = xr(q) * wr - xi(q) * wi
   ti = xr(q) * wi + xi(q) * wr
   
   xr(q) = xr(p) - tr
   xi(q) = xi(p) - ti
   xr(p) = xr(p) + tr
   xi(p) = xi(p) + ti
   
   p = p + le
Loop Until p > n - 1

wr = wr * w1r - wi * w1i
wi = wr * w1i - wi * w1r
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m

For i = 0 To n - 1 '仅输出模
   xr(i) = Sqr(xr(i) ^ 2 + xi(i) ^ 2)
   Next
   
End Sub


检验的时候可以这样:
Sub 检验()
Dim y(63) As Double
  For i = 0 To 64
  y(i) = Sin(2 * 3.1415926 * i / 16)
  Next
  倒序 y()
  蝶形算法 y()
  '现在结果在y()中
  

End Sub
搜索更多相关主题的帖子: 算法 Dim Sub Long Double 
2020-12-18 20:22
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
改变了一下代码:
Private Sub Command1_Click()
Dim y(64) As Double
  For i = 0 To 64
  y(i) = Sin(2 * 3.1415926 * i / 16)
  Next
  Text1 = y(64)
  '现在结果在y()中
  Print y(64)
End Sub

运行结果:text1=-4.28718345360413E-07
2020-12-18 20:33
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
、FFT算法概要:

 FFT(Fast Fourier Transformation)是离散傅氏变换(DFT)的快速算法。即为快速傅氏变换。它是根据离散傅氏变换的奇、偶、虚、实等特性,对离散傅立叶变换的算法进行改进获得的
原理大致是这样的:
 设x(n)为N项的复数序列,由DFT变换,任一X(m)的计算都需要N次复数乘法和N-1次复数加法,而一次复数乘法等于四次实数乘法和两次实数加法,一次复数加法等于两次实数加法,即使把一次复数乘法和一次复数加法定义成一次“运算”(四次实数乘法和四次实数加法),那么求出N项复数序列的X(m),即N点DFT变换大约就需要N^2次运算。当N=1024点甚至更多的时候,需要N2=1048576次运算,在FFT中,利用WN的周期性和对称性,把一个N项序列(设N=2k,k为正整数),分为两个N/2项的子序列,每个N/2点DFT变换需要(N/2)2次运算,再用N次运算把两个N/2点的DFT变换组合成一个N点的DFT变换。这样变换以后,总的运算次数就变成N+2*(N/2)^2=N+(N^2)/2。继续上面的例子,N=1024时,总的运算次数就变成了525312次,节省了大约50%的运算量。而如果我们将这种“一分为二”的思想不断进行下去,直到分成两两一组的DFT运算单元,那么N点的DFT变换就只需要N/2log2N次的运算,N在1024点时,运算量仅有5120次,是先前的直接算法的近1/200,点数越多,运算量的节约就越大,这就是FFT的优越性。
2020-12-19 21:14
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
改造后的代码及运行结果:
Private Sub Command1_Click()
Dim x_() As Double, a As String
a = Trim(Text1)
ReDim x_(1 To Len(a))
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = Len(a) '求数组大小,其值必须是2的幂
lh = n / 2
j = n / 2
For i = 1 To n - 2
If i < j Then '倒序
t = x_(j)
x_(j) = x_(i)
x_(i) = t
End If

Debug.Print i, j
k = lh '下面是向右进位算法
Do
If k > j Then Exit Do '高位是1吗
j = j - k '是的,高位置0
k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
j = j + k '非则若最高位是0,则置1
Text2 = Text2 & "  " & j
Next
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
运行结果:
Text1=1234567812345678
Text2=  4  12  2  10  6  14  1  9  5  13  3  11  7  15.
2020-12-24 20:01
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
Text1=12345678,
Text2= 2  6  1  5  3  7
2020-12-24 20:02
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
修改了一下程序运行结果仍然一样,修改后代码如下(不知道哪个正确):
Private Sub Command1_Click()
Dim x_() As Double, a As String
a = Trim(Text1)
ReDim x_(1 To Len(a))
For i1 = 1 To Len(a)
x_(i1) = Mid(a, i1, 1)
  Next
Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = Len(a) '求数组大小,其值必须是2的幂
lh = n / 2
j = n / 2
For i = 1 To n - 2
If i < j Then '倒序
t = x_(j)
x_(j) = x_(i)
x_(i) = t
End If

Debug.Print i, j
k = lh '下面是向右进位算法
Do
If k > j Then Exit Do '高位是1吗
j = j - k '是的,高位置0
k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
j = j + k '非则若最高位是0,则置1
Text2 = Text2 & "  " & j
Next
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
2020-12-24 20:20
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
改造后的蝶形运算程序和结果:
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
ReDim xr(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
xr(i1) = Mid(a, i1 + 1, 1)
  Next
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double
Dim xi()
n = Len(a) '求数组大小,其值必须是2的幂
m = 0
l = 2
pi = 3.14159265358979
Do
 l = l + l
 m = m + 1
 Loop Until l > n
 n = l / 2
ReDim xi(n - 1)

l = 1
Do
  le = 2 ^ l
  le1 = le / 2
  wr = 1
  wi = 0
  w1r = Cos(t)
  w1i = -Sin(t)
  r = 0
Do
  p = r
  Do
   q = p + le1
   
   tr = xr(q) * wr - xi(q) * wi
   ti = xr(q) * wi + xi(q) * wr
   
   xr(q) = xr(p) - tr
   xi(q) = xi(p) - ti
   xr(p) = xr(p) + tr
   xi(p) = xi(p) + ti
   
   p = p + le
Loop Until p > n - 1

wr = wr * w1r - wi * w1i
wi = wr * w1i - wi * w1r
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m

For i = 0 To n - 1 '仅输出模
   xr(i) = Sqr(xr(i) ^ 2 + xi(i) ^ 2)
   Text2 = Text2 & "  " & xr(i)
   Next
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
运算结果:
Text1=12345678,Text2=36  4  8  0  16  0  0  0,
Text1=1234567812345678,Text2= 72  8  16  0  32  0  0  0  0  0  0  0  0  0  0  0.
2020-12-24 20:45
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
程序出现了错误,怪不得了呀,修改了一下,如下为代码和计算结果:
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
ReDim xr(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
xr(i1) = Mid(a, i1 + 1, 1)
  Next
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double
Dim xi()
n = Len(a) '求数组大小,其值必须是2的幂
m = 0
l = 2
pi = 3.14159265358979
Do
 l = l + l
 m = m + 1
 Loop Until l > n
 n = l / 2
ReDim xi(n - 1)

l = 1
Do
  le = 2 ^ l
  le1 = le / 2
  wr = 1
  wi = 0
  t = pi / le1
  w1r = Cos(t)
  w1i = -Sin(t)
  r = 0
Do
  p = r
  Do
   q = p + le1
   
   tr = xr(q) * wr - xi(q) * wi
   ti = xr(q) * wi + xi(q) * wr
   
   xr(q) = xr(p) - tr
   xi(q) = xi(p) - ti
   xr(p) = xr(p) + tr
   xi(p) = xi(p) + ti
   p = p + le
Loop Until p > n - 1

wr = wr * w1r - wi * w1i
wi = wr * w1i - wi * w1r
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m

For i = 0 To n - 1 '仅输出模
   xr(i) = Sqr(xr(i) ^ 2 + xi(i) ^ 2)
   Text2 = Text2 & "  " & xr(i)
   Next
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
计算结果:
Text1=00000678,Text2= 21  5.19615242270664  2.60761871483253  2.80919177949488  21  5.19615242270664  2.60761871483253  2.80919177949488.
2020-12-24 23:57
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
输入00000678,输出:21+0i  -4.24264068711929+3i  -1.31801948466055+4.11396103067894i  1.31801948466053+1.00735931288072i  -21+0i  4.24264068711929+-3i  1.31801948466055+-4.11396103067894i  -1.31801948466053+-1.00735931288072i
仍然不对,代码如下:
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
ReDim xr(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
xr(i1) = Mid(a, i1 + 1, 1)
  Next
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double
Dim xi()
n = Len(a) '求数组大小,其值必须是2的幂
n1 = n
m = 0
l = 2
pi = 3.14159265358979
Do
 l = l + l
 m = m + 1
 Loop Until l > n
 n = l / 2
ReDim xi(n - 1)
l = 1
Do
  le = 2 ^ l
  le1 = le / 2
  wr = 1
  wi = 0
  t = pi / le1
  w1r = Cos(t)
  w1i = -Sin(t)
  r = 0
Do
  p = r
  Do
   q = p + le1
   
   tr = xr(q) * wr - xi(q) * wi
   ti = xr(q) * wi + xi(q) * wr
   
   xr(q) = xr(p) - tr
   xi(q) = xi(p) - ti
   xr(p) = xr(p) + tr
   xi(p) = xi(p) + ti
   p = p + le
Loop Until p > n - 1

wr = wr * w1r - wi * w1i
wi = wr * w1i + wi * w1r
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m

For i = 0 To n - 1 '仅输出模
   
   Text2 = Text2 & "  " & xr(i) & "+" & xi(i) & "i"
   Next
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
不知道咋错了,为啥?
2020-12-25 03:58
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
Text1=12345678,
 Text2= 2  6  1  5  3  7

这个结果也有问题,缺少0  4 两位,哪去了?
应该是0  4  2  6  1  5  3  7
2020-12-25 16:43



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-504309-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.336476 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved