数学中国

 找回密码
 注册
搜索
热搜: 活动 交友 discuz
楼主: ysr

大数乘法与快速傅里叶变换

[复制链接]
 楼主| 发表于 2021-1-6 23:25 | 显示全部楼层
输入:Text1 =00070608,Text2=00030402,结果:
/-26/-35/-13/-173/-9/59/-22/237
与正确值比较:0, 0, 0, 24, 46, 65, 38, 16也是不对。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-1-8 17:10 | 显示全部楼层
Public Sub fft()

pi = 3.14159265 'Set constants

1000 'THE FAST FOURIER TRANSFORM
'copyright ?1997-1999 by California Technical Publishing
'published with  permission from Steven W Smith, www.dspguide.com
'GUI by logix4u , www.logix4u.net
'modified by logix4u, www.logix4.net
1010 'Upon entry, N% contains the number of points in the DFT, REX[ ] and
1020 'IMX[ ] contain the real and imaginary parts of the input. Upon return,
1030 'REX[ ] and IMX[ ] contain the DFT output. All signals run from 0 to N%-1.
1060 NM1% = N% - 1
1070 ND2% = N% / 2
1080 M% = CInt(Log(N%) / Log(2))
1090 J% = ND2%
1100 '
1110 For i% = 1 To N% - 2 'Bit reversal sorting
1120 If i% >= J% Then GoTo 1190
1130 TR = REX(J%)
1140 TI = IMX(J%)
1150 REX(J%) = REX(i%)
1160 IMX(J%) = IMX(i%)
1170 REX(i%) = TR
1180 IMX(i%) = TI
1190 K% = ND2%
1200 If K% > J% Then GoTo 1240
1210 J% = J% - K%
1220 K% = K% / 2
1230 GoTo 1200
1240 J% = J% + K%
1250 Next i%
1260 '
1270 For L% = 1 To M% 'Loop for each stage
1280 LE% = CInt(2 ^ L%)
1290 LE2% = LE% / 2
1300 UR = 1
1310 UI = 0
1320 SR = Cos(pi / LE2%) 'Calculate sine & cosine values
1330 SI = -Sin(pi / LE2%)
1340 For J% = 1 To LE2% 'Loop for each sub DFT
1350 JM1% = J% - 1
1360 For i% = JM1% To NM1% Step LE% 'Loop for each butterfly
1370 IP% = i% + LE2%
1380 TR = REX(IP%) * UR - IMX(IP%) * UI 'Butterfly calculation
1390 TI = REX(IP%) * UI + IMX(IP%) * UR
1400 REX(IP%) = REX(i%) - TR
1410 IMX(IP%) = IMX(i%) - TI
1420 REX(i%) = REX(i%) + TR
1430 IMX(i%) = IMX(i%) + TI
1440 Next i%
1450 TR = UR
1460 UR = TR * SR - UI * SI
1470 UI = TR * SI + UI * SR
1480 Next J%
1490 Next L%
1500 '
End Sub
这是网上复制的程序,看不懂啊!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-3-2 01:23 | 显示全部楼层
哈哈哈!这回蒙对了!太激动了!下面是结果和程序代码:
输入:Text1=20403000,结果: 9+0i  4.12132034355965+-6.12132034355964i  -2+-3i  -0.121320343559644+1.87867965644035i  3+0i  -0.121320343559638+-1.87867965644036i  -2+3i  4.12132034355963+6.12132034355965i.

代码如下:

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 04:33 | 显示全部楼层
输入: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.
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-3-2 04:33 | 显示全部楼层
本帖最后由 ysr 于 2021-3-17 17:16 编辑

“让那些内外反动派在我们面前发抖吧,让他们去说我们这也不行那也不行吧,中国人民的不屈不挠的努力必将稳步地达到自己的目的!”
“我们的目的一定要达到,我们的目的一定能够达到!”————毛主席语录
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-3-2 07:02 | 显示全部楼层
倒序程序修改了一下就正确了:
输入: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
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-3-13 17:13 | 显示全部楼层
大整数快速乘法的一种新算法的链接:
https://www.docin.com/p-732940119.html
回复 支持 反对

使用道具 举报

 楼主| 发表于 2021-3-17 21:52 | 显示全部楼层
修改了一下程序,这回可能对了,哈哈哈!
程序结果:678*432=292896.  123*123=015129.
代码如下:(太激动了,明天再说!)

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
  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)
    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)), Trim(sb1))
   s3 = nifft(Trim(s), Trim(s1), Trim(sb1))
    Text2 = s2
End Sub

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

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
    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 = Val(j - sb1 - 1) To Val(j / 2 - 1)
    zr(j / 2 + i1) = 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-17 22:34 | 显示全部楼层
改进了一下,这回可能是正确了,删掉了最高位的非零数字,代码如下:

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
  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)
    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)), Trim(sb1))
   s3 = nifft(Trim(s), Trim(s1), Trim(sb1))
    Text2 = s2
End Sub

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

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
    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 - sb1 + 1)
    zr(sb1 + i1 - 2) = 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-17 23:10 | 显示全部楼层
本帖最后由 ysr 于 2021-3-17 15:20 编辑

还是有问题,末尾和中间有0的时候就不对了,咋回事呢?再说吧!各位老师晚安!
11111*202=02244422(这个倒是对的),1111111111*101=022321321310(这个不对了),应该是:
1111111111*101=112,222,222,211.

还得继续改进,谢谢各位老师和朋友!晚安!!

1111111111*202=0224444444422(这个倒是对的),咋回事呢?

再说吧,晚安!!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|数学中国 ( 京ICP备05040119号 )

GMT+8, 2024-3-29 21:34 , Processed in 0.071289 second(s), 14 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表