注册 登录
编程论坛 → VB6论坛

这个倒序和蝶形算法vb程序如何运行？

ysr2857 发布于 2020-12-18 20:22， 9922 次点击
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
89 回复
#2
ysr28572020-12-18 20:33
改变了一下代码：
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
#3
ysr28572020-12-19 21:14
、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的优越性。
#4
ysr28572020-12-24 20:01
改造后的代码及运行结果：
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.
#5
ysr28572020-12-24 20:02
Text1=12345678,
Text2= 2  6  1  5  3  7
#6
ysr28572020-12-24 20:20
修改了一下程序运行结果仍然一样，修改后代码如下（不知道哪个正确）：
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
#7
ysr28572020-12-24 20:45
改造后的蝶形运算程序和结果：
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.
#8
ysr28572020-12-24 23:57
程序出现了错误，怪不得了呀，修改了一下，如下为代码和计算结果：
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.
#9
ysr28572020-12-25 03:58
输入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
不知道咋错了，为啥？
#10
ysr28572020-12-25 16:43
Text1=12345678,
 Text2= 2  6  1  5  3  7

这个结果也有问题，缺少0  4 两位，哪去了？
应该是0  4  2  6  1  5  3  7
#11
ysr28572020-12-25 17:54
修改一下主楼的代码（转录错误，根据网上原稿改正，原稿是不让复制的）：
蝶形算法代码
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
t=pi/le1 '这一步缺少t值，补上了
   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
#12
ysr28572020-12-25 17:55
修改以后运行结果仍然不对，咋回事呢？
#13
ysr28572020-12-26 06:33
上班呢，明白了点好像，输入的时候各位数字要倒序：序号为01234567时，倒序为04261537
原数为00000678倒序为：
00070608.
下班试试吧
#14
ysr28572020-12-28 22:27
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

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) & "+" & xi(i) & "i"
   Next

End Sub

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

 输入：Text1 =80607000，结果：
    21+0i  13.4143937430245+-3.50000000000001i  4.40338197130883+-3.19974746830584i  6.56830852046515+-1.17525253169417i  
7+0i  4.64263292831844+3.49999999999999i  3.3449607857897+3.19974746830584i  9.60982505463419+1.17525253169419i
与正确值比较：12.9+10.9i, 2+7i, 3.1-1.1i, 7, 3.1+1.1i, 2-7i, 12.9-10.9i, 21也是不对。
#15
ysr28572020-12-28 22:32
例第A0项为：8→14→21最终输出21.
实际为8+6+7=21.
而第A1项为：8→8.0000000001→12.9492……最终输出13.41439……，咋回事呢？
实际为：8+7*0.7+6*0=8+4.9=12.9.
发一下截图：
只有本站会员才能查看附件，请 登录
只有本站会员才能查看附件，请 登录
#16
ysr28572020-12-28 22:44
速度快，可惜输出结果不对，不知道怎么改。
#17
ysr28572021-01-01 20:44
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 '仅输出模
   
   Text2 = Text2 & "  " & xr(i) & "+" & xi(i) & "i"
   Next
End Sub

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

输入：Text1 =80607000，结果：
 21+0i  3.05025253169415+-3.50000000000001i  7.97487373415292+6.69974746830583i  -0.962310601229371+-11.0747474683058i
  7+0i  12.9497474683058+3.49999999999999i  -3.97487373415292+-6.69974746830583i  16.9623106012294+11.0747474683058i
与正确值比较：12.9+10.9i, 2+7i, 3.1-1.1i, 7, 3.1+1.1i, 2-7i, 12.9-10.9i, 21也是不对。

可能是内层循环程序的乘法顺序不对了，不太懂原理，无法修改，望老师指正！
#18
ysr28572021-01-01 20:57
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 '仅输出模
   
   Text2 = Text2 & "  " & xr(i) & "+" & xi(i) & "i"
   Next
End Sub

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

 输入：Text1 =80607000，结果：
 21+0i  12.9497474683058+-3.50000000000001i  3.02512626584709+-3.19974746830584i  6.46231060122937+-1.17525253169417i  
7+0i  3.05025253169417+3.49999999999999i  0.974873734152908+3.19974746830584i  9.53768939877061+1.17525253169419i
与正确值比较：12.9+10.9i, 2+7i, 3.1-1.1i, 7, 3.1+1.1i, 2-7i, 12.9-10.9i, 21也是不对。
#19
ysr28572021-01-03 19:40
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   Text2 = Text2 & "  " & zr(i) & "+" & zi(i) & "i"
   Next
End Sub

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


 输入：Text1 =80607000，Text2=20403000,结果：
 189+0i  48.1200576850889+-33.8492424049177i  -9.10907287525383+0.845301243345486i  8.07394476689+-4.83093657874164i
  21+0i  -5.62005768508875+4.15075759508251i  -6.76592712474619+-6.46840725563929i  24.7688582392567+7.92894805108087i
这个与正确值不同，不知道逆变换能不能出来正确结果？
#20
ysr28572021-01-03 19:47
正确结果是：将她们逐项相乘得到向量 {Ck}，即 { C7, C6, C5, C4, C3, C2, C1, C0 }
= { -13.6+123.4i, -25-8i, -2.4-5.8i, 21, -2.4+5.8i, -25+8i, -13.6-123.4i, 189 }
#21
ysr28572021-01-04 11:45
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = zr(i) & "/" & s
   s1 = zi(i) & "/" & s1
   Next
   Text2 = s1
End Sub

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

输入：Text1 =80607000，Text2=20403000,结果：
实部： 24.76/-6.76/-5.62/21/8.07/-9.10/48.12/189/
虚部：  7.92/-6.46/4.15/0/-4.83/0.84/-33.84/0/
与正确值比较：-13.6+123.4i, -25-8i, -2.4-5.8i, 21, -2.4+5.8i, -25+8i, -13.6-123.4i, 189也是不对。

[此贴子已经被作者于2021-1-4 11:47编辑过]
#22
ysr28572021-01-06 21:40
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
   Dim c(), d()
s2 = Split(s, "/")
s3 = Split(s1, "/")
   j = UBound(s2)
  For k = 1 To j
      n1 = n1 + 1
       ReDim Preserve c(0 To n1 - 1)
       ReDim Preserve d(0 To n1 - 1)
      c(n1 - 1) = s2(n1): d(n1 - 1) = s3(n1)
    Next
   Text2 = s
End Sub

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


输入：Text1 =80607000，Text2=20403000,结果：
 /24.76/-6.76/-5.62/21/8.07/-9.10/48.12/189
  /7.92/-6.46/4.15/0/-4.83/0.84/-33.84/0
与正确值比较：-13.6+123.4i, -25-8i, -2.4-5.8i, 21, -2.4+5.8i, -25+8i, -13.6-123.4i, 189也是不对。
#23
ysr28572021-01-06 22:40
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  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
   
   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

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 '仅输出模

   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(yr(i), ".") = 0 Then
   yr(i) = yr(i)
   Else
   a2 = Left(yr(i), InStr(yr(i), ".") - 1)
   b2 = Mid(yr(i), InStr(yr(i), "."), 3)
   yr(i) = a2 & b2
   End If
   s = "/" & Val(zr(i) + yr(i)) & s
   Next
   
   
nifft = s

End Function



输入：Text1 =80607000，Text2=20403000,结果：
/13.13/-7.06/18.38/43.44/15.62/1.68/10.37/-32.22
与正确值比较：0, 0, 0, 0, 24, 46, 65, 38, 16也是不对。
#24
ysr28572021-01-06 23:00
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  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
   
   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

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 '仅输出模
zr(i) = xr(i) + yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   
   
nifft = s

End Function


输入：Text1 =80607000，Text2=20403000,结果：
/48/30/38/-159/43/-31/54/237
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。
#25
ysr28572021-01-06 23:09
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  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
   
   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

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 '仅输出模
zr(i) = xr(i) + yr(i) + xi(i) + yi(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   
   
nifft = s

End Function


输入：Text1 =80607000，Text2=20403000,结果：
/50/-65/44/-159/41/65/48/237
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。
#26
ysr28572021-01-07 16:28
Private Sub Command1_Click()
Dim x_() As Double, a As String
a = Trim(Text1)
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(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
ts = x_(j) & ts
ts1 = ts1 & "  " & j
Next
Text2 = ts & x_(n / 2) & x_(0)
End Sub

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



输入Text1=00000678,输出Text2=80607000.

[此贴子已经被作者于2021-1-7 16:30编辑过]
#27
ysr28572021-01-07 16:44
Private Sub Command1_Click()

Text2 = fftdx(Trim(Text1))
End Sub

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

Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(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
ts = x_(j) & ts
Next
fftdx = ts & x_(n / 2) & x_(0)
End Function




输入Text1=00000678,输出Text2=80607000.
#28
ysr28572021-01-07 17:44
Private Sub Command1_Click()

Text2 = fftdx(Trim(Text1))
End Sub

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

Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(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
ts = x_(j) & ts
Next
fftdx = ts & x_(n / 2) & x_(0)
End Function

Private Function fftdx1(sa As String) As String

Dim x_() As Double, a As String
a = sa
s2 = Split(sa, "/")
   j = UBound(s2)
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = s2(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


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
ts = "/" & x_(j) & ts
Next
fftdx = ts & "/" & x_(n / 2) & "/" & x_(0)
End Function


输入Text1=00000432,输出Text2=20403000.
#29
ysr28572021-01-07 18:11
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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()
sa = fftdx1(Trim(sa)): sb = fftdx1(Trim(sb))
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
  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
   
   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

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 '仅输出模
zr(i) = xr(i) + yr(i) + xi(i) + yi(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   
   
nifft = s

End Function


Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(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
ts = x_(j) & ts
Next
fftdx = ts & x_(n / 2) & x_(0)
End Function

Private Function fftdx1(sa As String) As String

Dim x_() As Double, a As String
a = sa
s2 = Split(sa, "/")
   j = UBound(s2)
ReDim x_(0 To j - 1)
For i1 = 0 To j - 1
x_(i1) = s2(i1 + 1)
 Next
Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = j '求数组大小，其值必须是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
ts = "/" & x_(j) & ts
Next
fftdx1 = ts & "/" & x_(n / 2) & "/" & x_(0)
End Function



输入Text1=80607000,Text2=20403000. 输出Text3=/174/224/165/140/162/239/171/237.
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。
#30
ysr28572021-01-07 18:15
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
  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
   
   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

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 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = "/" & zr(i) & s
   s1 = "/" & zi(i) & s1
   Next
  s2 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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()
sa = fftdx1(Trim(sa)): sb = fftdx1(Trim(sb))
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
  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
   
   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

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 '仅输出模
zr(i) = xr(i) + yr(i)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   
   
nifft = s

End Function


Private Function fftdx(sa As String) As String

Dim x_() As Double, a As String
a = sa
ReDim x_(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
x_(i1) = Mid(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
ts = x_(j) & ts
Next
fftdx = ts & x_(n / 2) & x_(0)
End Function

Private Function fftdx1(sa As String) As String

Dim x_() As Double, a As String
a = sa
s2 = Split(sa, "/")
   j = UBound(s2)
ReDim x_(0 To j - 1)
For i1 = 0 To j - 1
x_(i1) = s2(i1 + 1)
 Next
Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double, k As Long
'位序倒置
n = j '求数组大小，其值必须是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
ts = "/" & x_(j) & ts
Next
fftdx1 = ts & "/" & x_(n / 2) & "/" & x_(0)
End Function


输入Text1=80607000,Text2=20403000. 输出Text3=/171/235/157/140/165/228/179/237.
与正确值比较：0, 0, 0, 24, 46, 65, 38, 16也是不对。
#31
ysr28572021-02-08 22:59
程序结果不对，可能是蝶形运算程序不对，请参考下面图片中的内容：（都是vc程序咱不懂）
只有本站会员才能查看附件，请 登录
只有本站会员才能查看附件，请 登录
只有本站会员才能查看附件，请 登录
#32
ysr28572021-02-21 21:38
如下图片为傅里叶变换和逆变换的原理，如何用蝶形运算快速实现呢？
只有本站会员才能查看附件，请 登录
只有本站会员才能查看附件，请 登录
只有本站会员才能查看附件，请 登录
#33
ysr28572021-02-26 09:46
这个结果对，但不节约时间：text1=80607000时，结果为：  21+0i  12.9497474683058+-10.9497474683058i  2.00000000000001+-7.00000000000002i  3.05025253169415+1.05025253169416i  7+1.61554255216634E-14i  3.0502525316942+-1.05025253169419i  1.99999999999997+6.99999999999994i  12.9497474683057+10.9497474683059i
代码如下：

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()
 Dim yr(), yi()

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

 l = 1
 For i1 = 0 To Len(a) - 1
  tr1 = xr(0) * Cos(0): ti1 = xr(0) * Sin(0)
  tr2 = xr(4) * Cos((-2 * pi / 8) * i1): ti2 = xr(4) * Sin((-2 * pi / 8) * i1)
  tr3 = xr(2) * Cos((-2 * pi / 8) * i1 * 2): ti3 = xr(2) * Sin((-2 * pi / 8) * i1 * 2)
  yr(i1) = tr1 + tr2 + tr3: yi(i1) = ti1 + ti2 + ti3
  Next
  
 Do
   le = 2 ^ l
   le1 = le / 2
   wr = 1
   wi = 0
   t = pi / le1
   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); xi(p); le1, xr(q); xi(q); le1
   
   
    p = p + le
 Loop Until p > n - 2



 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 '仅输出模
Print xr(i), xi(i)
    Text2 = Text2 & "  " & yr(i) & "+" & yi(i) & "i"
    Next

 End Sub

 Private Sub Command2_Click()
 Text1 = ""
 Text2 = ""
 End Sub
#34
ysr28572021-02-28 08:50
程序弄不对，改进了一下，如下是结果和代码以及原理图片：
Text1=80607000,结果为： 8+16i  -1.29610059419054+-0.372221061679249i  3.05025253169417+8.70710678118656i  1.532843272421+4.59431073134172i  8+0i  1+-2.21998012670182i  8+-2.60660171779821i  8+-1.52862418649973i.
代码如下：

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)
  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
   m1 = (p + Len(a) / 2) Mod Len(a)
   xr(p) = xr(p) + xr(m1) * Sin((-2 * pi / Len(a)) * r * 2 ^ (m - le1))
 xr(q) = xr(p) - xr(m1) * Sin((-2 * pi / Len(a)) * r * 2 ^ (m - le1))
   xi(p) = xr(p) + xr(m1) * Cos((-2 * pi / Len(a)) * r * 2 ^ (m - le1))
   xi(q) = xr(p) - xr(m1) * Cos((-2 * pi / Len(a)) * r * 2 ^ (m - le1))
   
   Print p, q
   
   Print xr(p); xi(p); le1, xr(q); xi(q); le1
   
   
   p = p + le
Loop Until p > n - 2

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 '仅输出模
Print xr(i), xi(i)
   Text2 = Text2 & "  " & xr(i) & "+" & xi(i) & "i"
   Next

End Sub

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

原理图片：
只有本站会员才能查看附件，请 登录
只有本站会员才能查看附件，请 登录
只有本站会员才能查看附件，请 登录
#35
ysr28572021-02-28 09:23
图片中的-j应该是-i吧？网上的东西胡写八道，怎么就弄对了？
#36
ysr28572021-03-02 00:22
改了一下程序，仍然不对，下面是结果和代码：
输入：Text1=80607000,结果： 21+0i  14.467156727579+-8.67878402655563i  6.94974746830584+-4.94974746830583i  10.6787840265556+-0.467156727579004i  7+0i  1.532843272421+-3.32121597344437i  -2.94974746830584+4.94974746830583i  5.32121597344435+12.467156727579i.
代码如下：

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)
  Print l
  r = 0
Do
  p = r
  Do
   q = p + le1
   
   tr = xr(q) * Cos((-2 * pi / 2 ^ le1) * r)
   ti = xr(q) * Sin((-2 * pi / 2 ^ le1) * 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

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 '仅输出模
Print xr(i), xi(i)
   Text2 = Text2 & "  " & xr(i) & "+" & xi(i) & "i"
   Next

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
#37
ysr28572021-03-02 00:40
又改了一下程序，仍然不对，下面是结果和代码：
 输入：Text1=80607000,结果：  21+0i  8.86549696282261+-1.36563225411292i  8.46715672757901+-2.67878402655563i  19.8202872861178+-3.88899163113719i  7+0i  -4.86549696282261+1.36563225411288i  -4.46715672757901+2.67878402655563i  8.17971271388218+3.88899163113723i代码如下：

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)
   Print l
   r = 0
 Do
   p = r
   Do
    q = p + le1
   
    tr = xr(q) * Cos((-2 * pi / 2 ^ le1) * r * 2 ^ (m - le1))
    ti = xr(q) * Sin((-2 * pi / 2 ^ le1) * r * 2 ^ (m - le1))
   
    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
#38
ysr28572021-03-02 00:52
哈哈哈！这回可能蒙对了，太激动了！！
 如下是结果和程序代码：
 输入：Text1=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


明天再说！！

[此贴子已经被作者于2021-3-2 01:14编辑过]
#39
ysr28572021-03-02 06:43
倒序程序修改了一下就正确了：
输入：Text1=00000678,结果：80607000.
输入：Text1=00000432,结果：20403000.

代码如下：
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, 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
#40
ysr28572021-03-02 22:14
又不对了困难了，啊啊！
输入：Text1 =80607000，Text2=20403000,结果：
/29/65/34/24/10/2/11/16
与正确值比较：0, 0, 0, 0, 24, 46, 65, 38, 16也是不对。

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
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
 
  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)
   
   tr1 = yr(q) * Cos((-2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = s & "/" & zr(i)
   s1 = s1 & "/" & zi(i)
   Next
  s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)))
   Text2 = s2
End Sub

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

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 nifft(sa As String, sb 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 n - 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
  
  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)
   
   tr1 = yr(q) * Cos((-2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   
   
nifft = s

End Function


Private Function dxcx1(sa As String) As String

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

s2 = Split(sa, "/")

   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
#41
ysr28572021-03-03 10:44
改了一下（改了逆变换的符号）还是不对了困难了，啊啊！
输入：Text1 =80607000，Text2=20403000,结果：
/11/2/10/24/34/65/29/16
与正确值比较： 0, 0, 0, 24, 46, 65, 38, 16也是不对。

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
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
 
  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)
   
   tr1 = yr(q) * Cos((-2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   If InStr(zi(i), ".") = 0 Then
   zi(i) = zi(i)
   Else
   a2 = Left(zi(i), InStr(zi(i), ".") - 1)
   b2 = Mid(zi(i), InStr(zi(i), "."), 3)
   zi(i) = a2 & b2
   End If
   s = s & "/" & zr(i)
   s1 = s1 & "/" & zi(i)
   Next
  s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)))
   Text2 = s2
End Sub

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

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 nifft(sa As String, sb 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 n - 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
  
  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)
   
   tr1 = yr(q) * Cos((2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   
   
nifft = s

End Function


Private Function dxcx1(sa As String) As String

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

s2 = Split(sa, "/")

   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
#42
ysr28572021-03-03 11:22
中间过程比较（傅里叶正变换的结果与实际值的比较）：
/-13.65+124.39i/-25+-8.00i/-2.34+-5.60i/21+0i/-2.34+5.60i/-25+7.99i/-13.65+-124.39i/189+0i
与正确值比较：-13.6+123.4i, -25-8i, -2.4-5.8i, 21, -2.4+5.8i, -25+8i, -13.6-123.4i, 189
准确度差了点？
#43
ysr28572021-03-03 11:27
5.6与5.8,124.39与123.4？？咋回事呢？
#44
ysr28572021-03-03 20:52
改了一下（改了逆变换的符号）还是不对，啊啊！
 输入：Text1 =80607000，Text2=20403000,结果：
/12/0/9/24/34/65/29/16
与正确值比较： 0, 0, 0, 24, 46, 65, 38, 16也是不对。
看上去是A1+A4=A1,A2+A6=A2,A3+A7=A3？？手工计算一下就得到：/0/0/0/24/46/65/38/16，错位相加就可以得到正确答案了。
正确答案是：292896.
代码如下：

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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
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
 
  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)
   
   tr1 = yr(q) * Cos((-2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If

   s = s & "/" & zr(i)
   s1 = s1 & "/" & zi(i)
   Next
  s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)))
  s3 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  
  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)
   
   tr1 = yr(q) * Cos((2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   zr(4) = Val(zr(4)) + 0.5
   zr(1) = Val(zr(1)) + Val(zr(5) + 0.5)
   zr(2) = Val(zr(2)) + Val(zr(6) + 0.5)
   zr(3) = Val(zr(3)) + Val(zr(7) + 0.5)
   zr(5) = 0: zr(6) = 0: zr(7) = 0
   
   For I1 = 0 To n - 1
   s5 = "/" & Int(zr(I1)) & s5
   If I1 = 0 Then
   s6 = Mid(s5, 2, 1)
   s8 = Mid(s5, 3, 1)
   ElseIf Val(zr(I1)) > 0 Then
   s7 = Val(Mid(s5, 2, 2)) + Val(s6)
   s10 = Mid(s7, 2)
   s11 = s10 & s11
   s6 = Left(s7, 1)
   Else
   s6 = s6
   End If
   
   Next
   s9 = s6 & s11 & s8
   
nifft = 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
#45
ysr28572021-03-04 01:48
啥情况？只要最高位出现9，结果都能符合实际：
如：678*923=625794，而程序结果：/0/0/0/54/75/104/37/24，错位相加得到：625794.
678*993=673254，而程序结果：/0/0/0/54/117/153/93/24，错位相加得到：673254.
678*999=677322，而程序结果：/0/0/0/54/117/189/135/72，错位相加得到：677322.
978*123=120294，而程序结果：/0/0/0/9/25/49/37/24，错位相加得到：120294.
999*999=998001，而程序结果：/0/0/0/79/162/243/162/83，错位相加得到：978003（这个不对了）.
999*99=98901，而程序结果/0/0/0/4/81/162/162/81，错位相加得到：138901（这个不对了）.

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
b = Trim(Text3)
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 = a: b = b
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
 
  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)
   
   tr1 = yr(q) * Cos((-2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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)
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If

   s = s & "/" & zr(i)
   s1 = s1 & "/" & zi(i)
   Next
  s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)))
  s3 = nifft(Trim(s), Trim(s1))
   Text2 = s2
End Sub

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

Private Function nifft(sa As String, sb 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
  
  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)
   
   tr1 = yr(q) * Cos((2 * pi / 2 ^ l) * r)
   ti1 = yr(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
   
    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


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
   If InStr(zr(i), ".") = 0 Then
   zr(i) = zr(i)
   Else
   a1 = Left(zr(i), InStr(zr(i), ".") - 1)
   b1 = Mid(zr(i), InStr(zr(i), "."), 3)
   zr(i) = a1 & b1
   End If
   
   s1 = Int(Val(zr(i) + 0.5))
   s = "/" & s1 & s
   Next
   
   zr(0) = Val(zr(0)) + 0.5
   zr(2) = Val(zr(2)) + 0.5
   zr(4) = Val(zr(4)) + 0.5
   zr(1) = Val(zr(1)) + Val(zr(5) + 0.5)
   zr(3) = Val(zr(3)) + Val(zr(7) + 0.5)
   zr(5) = 0: zr(6) = 0: zr(7) = 0
   
   For I1 = 0 To n - 1
   s5 = "/" & Int(zr(I1)) & s5
   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 = s6
   End If
   
   Next
   s9 = s6 & s11 & s8
   
nifft = 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
#46
ysr28572021-03-04 22:42
回复 45楼 ysr2857
修改了代码，只有被乘数和乘数都是小于4位的数才有个别正确，咋回事呢？
代码如下：

Private Sub Command1_Click()
 Dim xr() As Double, a As String
 a = Trim(Text1)
 b = Trim(Text3)
 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
  
   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)
   
    tr1 = yr(q) * Cos((-2 * pi / 2 ^ l) * r)
    ti1 = yr(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
   
     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


 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)
    If InStr(zr(i), ".") = 0 Then
    zr(i) = zr(i)
    Else
    a1 = Left(zr(i), InStr(zr(i), ".") - 1)
    b1 = Mid(zr(i), InStr(zr(i), "."), 3)
    zr(i) = a1 & b1
    End If

    s = s & "/" & zr(i)
    s1 = s1 & "/" & zi(i)
    Next
   s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)))
   s3 = nifft(Trim(s), Trim(s1))
    Text2 = s2
 End Sub

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

 Private Function nifft(sa As String, sb 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
   
   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)
   
    tr1 = yr(q) * Cos((2 * pi / 2 ^ l) * r)
    ti1 = yr(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
   
     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


 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
    If InStr(zr(i), ".") = 0 Then
    zr(i) = zr(i)
    Else
    a1 = Left(zr(i), InStr(zr(i), ".") - 1)
    b1 = Mid(zr(i), InStr(zr(i), "."), 3)
    zr(i) = a1 & b1
    End If
   
    s1 = Int(Val(zr(i) + 0.5))
    s = "/" & s1 & s
    zr(i) = s1
    Next
    For i1 = 1 To Val(j / 4 - 1)
    zr(i1) = Val(zr(i1)) + Val(zr(j / 2 + i1))
    zr(j / 2 + i1) = 0
    Next
    For i2 = j / 4 + 1 To j / 2 - 1
    zr(i2) = Val(zr(i2)) + Val(zr(j / 2 + i2))
    zr(j / 2 + i2) = 0
    Next
   
   
    For i1 = 0 To n - 1
    s5 = "/" & Int(zr(i1)) & s5
    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 = s6
    End If
   
    Next
    s9 = s6 & s11 & s8
   
 nifft = 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-3-5 17:21编辑过]
#47
ysr28572021-03-05 12:59
快速傅里叶逆变换有问题？咋回事呢？咋逆不回去？
#48
ysr28572021-03-10 21:23
输入：Text1=456789,Text2=123456,程序结果为：/278.65+416.29/-20.48+113.74/11.51+33.76/9.99+45/-1.04+12.07/-3.51+-6.25/-5.13+-17.39/9+0
/-5.13+17.39/-3.51+6.25/-1.04+-12.07/10.00+-45.00/11.51+-33.76/-20.48+-113.74/278.65+-416.29/819+0.
#49
ysr28572021-03-11 18:23
456789*123456=56393342784,咋连这么小的数都算不对？
#50
ysr28572021-03-11 18:49
手工逆变换计算得到：A0=1367.99/16=85.499375，这个可能就不对，应该是94？

[此贴子已经被作者于2021-3-11 21:56编辑过]
#51
ysr28572021-03-11 21:51
手工计算太费劲，计算得到：A1=630.93/16=39.433125.
显然和程序结果不符。咋回事呢？
12
©2025, BC-CN.NET
电脑版