标题:这个倒序和蝶形算法vb程序如何运行?
只看楼主
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*9=9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999有100位,用时7.092285E-02秒.
晚安吧!还有客人呢?祝愿各位老师做个好梦,您安好!
2021-03-20 00:27
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
12345678*23456789=289289589963907942有18位,用时0.015625秒(这个不对,最高位咋多了3位呢? 应该是15位:289589963907942).
1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*9=1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*9=999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999有96位,用时0.1230469秒(这个不对,咋又少了4位?应该是100位).
11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有423位,用时0.5546875秒(这个不对,应该是331位,咋多了423-331=92位?).
1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=112222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有324位,用时0.546875秒(哈哈,这个可能是对的)。

这都是修改以后的程序结果,修改为4位一组了。
2021-03-20 08:46
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
如下程序是没有优化的,比前面多加了一个去掉前导0的程序,虽然速度慢运行可靠,结果准确,需要优化,重发一下,希望老师帮助优化程序提高速度,谢谢您!

Private Sub Command1_Click()
 Dim xr() As Double, a As String
 a = Trim(Text1)
 b = Trim(Text3)
 ts = Timer
 sb1 = Len(a) + Len(b)
 sb2 = Log(sb1) / Log(2)
 If InStr(sb2, ".") = 0 Then
 sb2 = sb2
 Else
 sb2 = Int(sb2) + 1
 End If
 sb = 2 ^ sb2
 Print sb
 If Len(a) = Len(b) And 2 ^ (Int(Log(Len(a)) / Log(2))) = Len(a) Then
   a = String(Val(sb) - Len(a), "0") & a
 b = String(Val(sb) - Len(b), "0") & b
 a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
 Else

 a = String(Val(sb) - Len(a), "0") & a
 b = String(Val(sb) - Len(b), "0") & b
 a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
 End If
 ReDim xr(0 To Len(a) - 1): ReDim yr(0 To Len(b) - 1): ReDim zr(0 To Len(b) - 1)
 For i1 = 0 To Len(a) - 1
 xr(i1) = Mid(a, i1 + 1, 1)
 yr(i1) = Mid(b, 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, tr1 As Double
 Dim xi(): Dim yi(): Dim zi()
 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): ReDim yi(n - 1): ReDim zi(n - 1)

 l = 1
 Do
   le = 2 ^ l
   le1 = le / 2
   wr = 1
   wi = 0
   If l = 1 Then
   t = 0
   Else
   t = pi / le1
   End If
   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
    tr1 = yr(q) * wr - yi(q) * wi
    ti1 = yr(q) * wi + yi(q) * wr
   
   
    xr(q) = xr(p) - tr
    xi(q) = xi(p) - ti
    xr(p) = xr(p) + tr
    xi(p) = xi(p) + ti
   
      yr(q) = yr(p) - tr1
     yi(q) = yi(p) - ti1
     yr(p) = yr(p) + tr1
     yi(p) = yi(p) + ti1
   
     p = p + le
 Loop Until p > n - 1


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

 For i = 0 To n - 1 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
     

     s = s & "/" & zr(i)
     s1 = s1 & "/" & zi(i)
     Next
    s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     Text2 = s2 & "有" & Len(s2) & "位,用时" & Timer - ts & "秒"
 End Sub

 Private Sub Command2_Click()
 Text1 = ""
 Text2 = ""
 Text3 = ""
 Form1.Cls
 End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function

 Private Function nifft(sa As String, sb As String, sb1 As String) As String
 Dim l As Long, le As Long, le1 As Long, j 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, tr1 As Double
 Dim xi(): Dim yi(): Dim zi()
 Dim xr(), yr(), zr()
 s2 = Split(sa, "/")
 s3 = Split(sb, "/")
     j = UBound(s2)
     n = j
    For k = 1 To j
        n1 = n1 + 1
         ReDim Preserve xr(0 To n1 - 1)
         ReDim Preserve yr(0 To n1 - 1)
        xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
      Next
   

 ReDim zr(0 To j - 1)

 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): ReDim yi(n - 1): ReDim zi(n - 1)

 l = 1
 Do
   le = 2 ^ l
   le1 = le / 2
   wr = 1
   wi = 0
   If l = 1 Then
   t = 0
   Else
   t = -1 * pi / le1
   End If
   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
    tr1 = yr(q) * wr - yi(q) * wi
    ti1 = yr(q) * wi + yi(q) * wr
   
   
    xr(q) = xr(p) - tr
    xi(q) = xi(p) - ti
    xr(p) = xr(p) + tr
    xi(p) = xi(p) + ti
   
      yr(q) = yr(p) - tr1
     yi(q) = yi(p) - ti1
     yr(p) = yr(p) + tr1
     yi(p) = yi(p) + ti1
   
     p = p + le
 Loop Until p > n - 1


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

 For i = 0 To n - 1 '仅输出模
zr(i) = (xr(i) - yi(i)) / n
     
   
     s1 = Int(Val(zr(i) + 0.5))
     zr(i) = s1
     Next
     For i1 = 1 To Val(j - sb1 + 1)
     zr(sb1 + i1 - 2) = 0
     Next
     
   
   
     For i1 = 0 To n - 1
     If zr(i1) < 0 Then
     zr(i1) = 0
     Else
     zr(i1) = zr(i1)
     End If
     
     If i1 = 0 Then
     s6 = Int(zr(i1)) \ 10
     s8 = Int(zr(i1)) Mod 10
     ElseIf Val(zr(i1)) >= 0 Then
     s7 = Int(zr(i1)) + Val(s6)
     s10 = Val(s7) Mod 10
     s11 = s10 & s11
     s6 = Val(s7) \ 10
     Else
     s6 = Val(s6)
     End If
   
     Next
     s9 = s6 & s11 & s8
   
 nifft = qdqd0(Trim(s9))

 End Function

 Private Function dxcx0(sa As String, sb As String) As String

 Dim x_() As Double, a As String
   a = Trim(sa)
   ReDim x_(1 To sb)
   For i1 = 1 To sb
   x_(i1) = Mid(a, sb - i1 + 1, 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 = sb '求数组大小,其值必须是2的幂
lh = n / 2
   j = n / 2
   For i = 1 To n - 2


   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
   s = s & x_(j + 1)
   Next
   dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

 End Function

 Private Function dxcx1(sa As String) As String

 Dim x_() As Double, a As String
   a = Trim(sa)
   

 s2 = Split(sa, "/")
 s3 = Split(sb, "/")
     j = UBound(s2)
     sb = j
   
      ReDim x_(1 To sb)
    For k = 1 To j
        n1 = n1 + 1
         ReDim Preserve x_(1 To n1)
      
        x_(n1) = s2(n1)
      Next
   Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double
   '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
   j = n / 2
   For i = 1 To n - 2


   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
   s = s & "/" & x_(j + 1)
   Next
   dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
   End Function
2021-03-20 18:22
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
优化没有完成的程序结果,比没有优化的速度提高了一点,略有提高:
1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=112222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有324位,用时0.5078125秒
2021-03-20 18:32
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
这个是模仿手工计算的程序结果,在几百位以内还是快的,比傅立叶变换还快?结果如下:
1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=112222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有324位,用时0秒.

看起来,最快的是数论变换,有必要学习探讨沟通一下,先优化一下这个程序,不行的话继续研究学习数论变换以得到更快的程序。
2021-03-20 18:47
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 72楼 ysr2857
1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=112222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有324位,用时0.1849976秒(这是4位一组的程序结果,速度还有提升空间)
2021-03-21 00:08
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 67楼 ysr2857
11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=1122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有331位,用时0.1830444秒(速度还有提升空间)
2021-03-21 00:11
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
55#楼的程序,就是蝶形算法快速变换,重发一下这个程序及计算举例的程序结果:
实际值:12.9+10.9i, 2+7i, 3.1-1.1i, 7, 3.1+1.1i, 2-7i, 12.9-10.9i, 21
输入:80607000,程序结果:12.9497474683058+10.9497474683058i  1.99999999999999+7i  3.05025253169417+-1.05025253169417i  
7+0i  3.05025253169417+1.05025253169415i  2.00000000000001+-7i  12.9497474683058+-10.9497474683058i  21+0i  

代码如下:
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
  If l = 1 Then
  t = 0
  Else
  t = pi / le1
  End If
  w1r = Cos(t)
  w1i = -Sin(t)
  Print l
  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
   Print p, q
   
   Print xr(p), xr(q)
   
   
   p = p + le
Loop Until p > n - 2


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

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

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub

其中用到的三角函数公式是两角和的公式,推到证明如下:
程序中的点值的正弦余弦是用如下公式计算的:
cos(θ + δ) = cosθ - [ α cosθ+ βsinθ ]
sin(θ + δ) = sinθ - [ α sinθ- βcosθ ]其中 α, β 是预先计算的系数:α = 2 (sin(δ/2))^2,β = sinδ 。这个公式对吗?下面证明:
因为α = 2 [sin(δ/2)]^2,β = sinδ ,

所以,cosθ - [ α cosθ+ βsinθ ]={1-2 [sin(δ/2)]^2}cosθ-sinδsinθ= cosθcosδ-sinθsinδ=cos(θ + δ).

sinθ - [ α sinθ- βcosθ ]={1-2 [sin(δ/2)]^2}sinθ+sinδ cosθ=cosδsinθ+sinδ cosθ=sin(θ + δ).

当θ=0时公式变为:
cos(θ + δ) = cosθ - [ α cosθ+ βsinθ ]=1-α
sin(θ + δ) = sinθ - [ α sinθ- βcosθ ]=β
α = 2 (sin(δ/2))^2.
这里的快速傅里叶变换中好像就是这么用的,其中的cosδ和sinδ经常乘以1或0,大概就是这样子。
这里δ=π/n,而不再是2π/n,这样得到的三角函数值可能是更精确一些。如果不精确,则对称性不对称了,共轭复数不共轭了,逆变换就会出错,尤其大数据中间即使有一个数字出错,那也是无法修正的,那程序就无法用了。
2021-04-18 21:50
xulaoban
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2021-9-21
得分:0 
你好 这个FFT蝶形运算代码 我在网上也看到了  但是运用在VB中 对数据做FFT获取频率时   现实的频率还是不对  而且基本是五秒显示一次   (需要的是一秒变换一次)  这个代码写好了吗
2022-03-27 20:34
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 79楼 xulaoban
您可以试试下面这个:
蝶形运算程序:(自己试编的)
输入:80607000(接倒序程序的输出),输出:21+0i  12.9497474683058+-10.9497474683058i  2.00000000000001+-7i  3.05025253169417+1.05025253169416i  7+0i  3.05025253169417+-1.05025253169417i  1.99999999999999+7i  12.9497474683058+10.9497474683058i。代码如下:
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
  Print l
  r = 0
Do
  p = r
  Do
   q = p + le1
   
   tr = xr(q) * Cos((-2 * pi / 2 ^ l) * r)
   ti = xr(q) * Sin((-2 * pi / 2 ^ l) * r)
   
   xr(q) = xr(p) - tr
   xi(q) = xi(p) - ti
   xr(p) = xr(p) + tr
   xi(p) = xi(p) + ti
   Print p, q
   
   Print xr(p); xi(p); r, xr(q); xi(q); r
   
   
   p = p + le
Loop Until p > n - 2


r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m

For i = 0 To n - 1 '输出点值
Print xr(i), xi(i)
   Text2 = Text2 & "  " & xr(i) & "+" & xi(i) & "i"
   Next

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub

这个前面还要加上个倒序程序:
倒序程序:
输入:000678,输出:80607000。代码如下:
Private Sub Command1_Click()
 Dim x_() As Double, a As String
 a = Trim(Text1)
 x = Len(a): y = Int(Log(x) / Log(2)): y = y + 1
 x = 2 ^ y
 a = String(x - Len(a), "0") & a
 ReDim x_(1 To Len(a))
 For i1 = 1 To Len(a)
 x_(i1) = Mid(a, Len(a) - i1 + 1, 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


 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 & x_(j + 1)
 Next
 Text2 = x_(1) & x_(1 + Len(a) / 2) & Text2
 
 End Sub

 Private Sub Command2_Click()
 Text1 = ""
 Text2 = ""
 End Sub
2022-03-29 10:32



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




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

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