标题:这个倒序和蝶形算法vb程序如何运行?
只看楼主
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
手工计算太费劲,计算得到:A1=630.93/16=39.433125.
显然和程序结果不符。咋回事呢?
2021-03-11 21:51
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
VC版大数乘法程序(迭代型),不知道能不能运行?(我不懂VC程序,希望老师帮忙翻译成VB程序试试,谢谢!)

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdbool.h>
#include <math.h>
#include <conio.h>
#define N 150010
const double pi = 3.141592653;
char s1[N>>1], s2[N>>1];
double rea[N], ina[N], reb[N], inb[N];
int ans[N>>1];
 
void Swap(double *x, double *y)
{
    double t = *x;
    *x = *y;
    *y = t;
}
 
int Rev(int x, int len)
{
    int ans = 0;
    int i;
    for(i = 0; i < len; i++){
        ans <<= 1;
        ans |= (x & 1);
        x >>= 1;
    }
    return ans;
}
 
void FFT(double *reA, double *inA, int n, bool flag)
{
    int s;
    double lgn = log((double)n) / log((double)2);
    int i;
    for(i = 0; i < n; i++){
        int j = Rev(i, lgn);
        if(j > i){
            Swap(&reA[i], &reA[j]);
            Swap(&inA[i], &inA[j]);
        }
    }
    for(s = 1; s <= lgn; s++){
        int m = (1<<s);
        double reWm = cos(2*pi/m), inWm = sin(2*pi/m);
        if(flag) inWm = -inWm;
        int k;
        for(k = 0; k < n; k += m){
            double reW = 1.0, inW = 0.0;
            int j;
            for(j = 0; j < m / 2; j++){
                int tag = k+j+m/2;
                double reT = reW * reA[tag] - inW * inA[tag];
                double inT = reW * inA[tag] + inW * reA[tag];
                double reU = reA[k+j], inU = inA[k+j];
                reA[k+j] = reU + reT;
                inA[k+j] = inU + inT;
                reA[tag] = reU - reT;
                inA[tag] = inU - inT;
                double rew_t = reW * reWm - inW * inWm;
                double inw_t = reW * inWm + inW * reWm;
                reW = rew_t;
                inW = inw_t;
            }
        }
    }
    if(flag){
        for(i = 0; i < n; i++){
            reA[i] /= n;
            inA[i] /= n;
        }
    }
}
 int main()
{
#if 0
    freopen("in.txt","r",stdin);
#endif
    while(~scanf("%s%s", s1, s2)){
        memset(ans, 0 , sizeof(ans));
        memset(rea, 0 , sizeof(rea));
        memset(ina, 0 , sizeof(ina));
        memset(reb, 0 , sizeof(reb));
        memset(inb, 0 , sizeof(inb));
        int i, lent, len = 1, len1, len2;
        len1 = strlen(s1);
        len2 = strlen(s2);
        lent = (len1 > len2 ? len1 : len2);
        while(len < lent) len <<= 1;
        len <<= 1;
        for(i = 0; i < len; i++){
            if(i < len1) rea[i] = (double)s1[len1-i-1] - '0';
            if(i < len2) reb[i] = (double)s2[len2-i-1] - '0';
            ina[i] = inb[i] = 0.0;
        }
        FFT(rea, ina, len, 0);
        FFT(reb, inb, len, 0);
        for(i = 0; i < len; i++){
            double rec = rea[i] * reb[i] - ina[i] * inb[i];
            double inc = rea[i] * inb[i] + ina[i] * reb[i];
            rea[i] = rec; ina[i] = inc;
        }
        FFT(rea, ina, len, 1);
        for(i = 0; i < len; i++)
            ans[i] = (int)(rea[i] + 0.4);
        for(i = 0; i < len; i++){
            ans[i+1] += ans[i] / 10;
            ans[i] %= 10;
        }
        int len_ans = len1 + len2 + 2;
        while(ans[len_ans] == 0 && len_ans > 0) len_ans--;
        for(i = len_ans; i >= 0; i--)
            printf("%d", ans[i]);
        printf("\n");
    }
    return 0;
}
2021-03-14 14:06
abc238361
Rank: 1
等 级:新手上路
威 望:1
帖 子:19
专家分:0
注 册:2021-3-14
得分:0 
2021-03-15 11:00
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 53楼 abc238361
谢谢关注和沟通!我有模仿手工计算的大整数的乘法程序,是可调用程序,结果准确可靠,就是速度慢,但几百位以内的没问题,可以快速算出来,再大的就慢了。代码再重发如下:
乘法和除法(仅仅计算整数)也发一下,速度太慢仅做参考!
 乘法程序:
Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
 Dim a() As Integer
 ReDim a(1 To x + Y, 1 To Y)
 Dim I, J, C1, C2, CJ, JW
 For J = Y To 1 Step -1 'D2
 JW = 0 '进位清0
 C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
   C1 = Mid$(D1, I, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = I + J: r = Y + 1 - J
   a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
 a(c - 1, r) = JW
 Next
 Dim b() As Integer
 ReDim b(1 To x + Y)
 JW = 0
 For I = x + Y To 1 Step -1
 Bit = JW
 For J = 1 To Y
   Bit = Bit + a(I, J)
 Next
 b(I) = Bit Mod 10
 JW = Bit \ 10
 Next
 If b(1) > 0 Then
 MbC = MbC & b(1)
 Else
 MbC = MbC
 End If
 For I = 2 To x + Y
 MbC = MbC & b(I)
 Next
 End Function

除法程序:(此程序只用于其中的除数小于8位的)(注意:输出的“/”号后面的是余数)
Public Function MCC(D1 As String, D2 As String) As String ';除数少于8位的除法
If Len(D1) < Len(D2) Then
    MCC = "0" & "/" & D1
    Else
    If Len(D1) < 9 Then
     MCC = Val(D1) \ Val(D2) & "/" & Val(D1) - (Val(D1) \ Val(D2)) * Val(D2)
      If Mid(MCC, InStr(MCC, "/") + 1) = 0 Then
   MCC = Left(MCC, InStr(MCC, "/") - 1)
 Else
 MCC = MCC
 End If
   
     Else
   
    Dim x ';fen duan changdu
    x = Len(D1)
   
      
   
      Dim a() As String
       ReDim a(1 To x)  ';定义数组的储存空间
      For I = 1 To x Step 1  ';把被除数各位放在a()中
       a(I) = Mid(D1, I, 1)
         
      
        Next I
       Dim b() As String
       JW = 0
      ReDim b(1 To x)
      For J = 1 To x Step 1
     b(J) = Val(JW & a(J)) \ Val(D2)
       JW = Val(JW & a(J)) - Val(b(J)) * Val(D2)
        Next J
        For r = 1 To x
        If JW = 0 Then
           MCC = MCC & b(r)
           Else
           CJ = CJ & b(r)
           MCC = CJ & "/" & JW
      
     End If
   
     For I = 1 To Len(MCC)
    If Not Mid(MCC, I, 1) = "0" Then
        Exit For
    End If
 Next
 strtmp = Mid(MCC, I)
 If Len(strtmp) = 0 Then
 MCC = "0"
 Else
 MCC = strtmp
 End If
   
    Next
   
    End If
      
      End If
   
 End Function

除法程序:(用于除数多于8位的)(注意:输出的“/”号后面的是余数)
Public Function MCC1(D1 As String, D2 As String) As String ';大整数的除法
Dim ss
 ss = MBJC(D1, D2)
 If ss = -1 Then
 MCC1 = "0" & "/" & D1
   Else
   If ss = 0 Then
    MCC1 = 1
    Else
    If Len(D1) = Len(D2) Then
      s = Val(Left(D1, 1)) \ Val(Left(D2, 1))

 Do While MBJC(MbC(Trim(s), Trim(D2)), D1) = 1
   s = s - 1
   Loop
   If MBJC(MbC(Trim(s), Trim(D2)), D1) = 0 Then
    MCC1 = s
    Else
    MCC1 = s & "/" & MPC(Trim(D1), MbC(Trim(s), Trim(D2)))

 End If
     Else
     If Len(D2) < 9 Then
      MCC1 = MCC(D1, D2)
      Else
     Dim x, Y ';定义分段长度
    x = Len(D1): Y = Len(D2)
   
 Dim JW, jcc, jss, jcs

   Dim a() As String, b() As String
   
   ReDim a(1 To x)
   ReDim b(1 To Y)
   For I = 1 To x
   a(I) = Mid(D1, I, 1)
   Next
   For J = 1 To Y
   b(J) = Mid(D2, J, 1)
   Next
   jcc = Val(a(1) & a(2)) \ Val(b(1) & b(2))
   
      
         
   jss = MbC(Trim(jcc), D2)
    For i1 = 1 To Y
     jws = jws & a(i1)
       Next
      
       Do While MBJC(Trim(jws), Trim(jss)) = -1
       jcc = jcc - 1
       jss = MbC(Trim(jcc), D2)
       Loop
   JW = MPC(Trim(jws), Trim(jss))
   
     z = x - Y
   
     Dim c() As String
     ReDim c(1 To z)
     For s = 1 To z
      If MBJC(JW & a(s + Y), D2) = -1 Then
        c(s) = "0"
        Else
      jwc = Val(Left(JW & a(s + Y), 3)) \ Val(Left(D2, 2))
       If Len(jwc) > 1 Then
       c(s) = "9"
        Else
         c(s) = jwc
          End If
      
      Do While MBJC(JW & a(s + Y), MbC(Val(c(s)), D2)) = -1
     c(s) = Right(10000 + Val(c(s) - 1), 1)
      Loop
      End If
   
      JW = MPC(JW & a(s + Y), MbC(Val(c(s)), D2))
      
     jcc = jcc & c(s)
     Next s
     If JW = 0 Then
     MCC1 = jcc
     Else
     MCC1 = jcc & "/" & JW
     End If
   
   For I = 1 To Len(MCC1)
     If Not Mid(MCC1, I, 1) = "0" Then
         Exit For
     End If
 Next
 strtmp = Mid(MCC1, I)
   If Len(strtmp) = 0 Then
   MCC1 = "0"
   Else
 MCC1 = strtmp
 End If
   
   
   
     End If
   
   
   
   
   
   
   End If
 End If
 End If
 End Function

比较大小的程序:(注意:除法会调用此程序的,否则除法就无法运行了)

Public Function MBJC(D1 As String, D2 As String) As String ';bijiao
 If Len(D1) <= 10 And Len(D2) <= 10 Then
 If Val(D1) > Val(D2) Then
 MBJC = 1
 Else
 If Val(D1) = Val(D2) Then
 MBJC = 0
 Else
 MBJC = -1
 End If
 End If
 Else

 If Len(D1) > Len(D2) Then
 MBJC = 1
 Else
 If Len(D1) < Len(D2) Then
 MBJC = -1
 Else
 If Len(D1) = Len(D2) Then
 Dim x, Y
 x = Len(D1) \ 4: Y = Len(D2) \ 4
 Dim a() As String, b() As String
 ReDim a(4 To 4 * x + 4)
 ReDim b(4 To 4 * Y + 4)
 If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
   MBJC = 1
   Else
   If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
   MBJC = -1
   Else
   For I = 4 To 4 * x Step 4
   a(I) = Mid(D1, Len(D1) - I + 1, 4)
   b(I) = Mid(D2, Len(D2) - I + 1, 4)
   Next
   J = 4 * x
   Do While a(J) = b(J) And J >= 8
   
   J = J - 4
      Loop
      
      
    If Val(a(J)) - Val(b(J)) > 0 Then
    MBJC = 1
    Else
    If Val(a(J)) - Val(b(J)) < 0 Then
    MBJC = -1
    Else
    MBJC = 0
    End If
   
   End If
   
   
   
 End If
 End If
 End If
 End If
 End If
 End If
 End Function
2021-03-15 11:46
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 14楼 ysr2857
修改了一下14#楼的程序,这回可能对了,哈哈哈!
实际值:12.9+10.9i, 2+7i, 3.1-1.1i, 7, 3.1+1.1i, 2-7i, 12.9-10.9i, 21
输入:80607000,程序结果:12.9497474683058+10.9497474683058i  1.99999999999999+7i  3.05025253169417+-1.05025253169417i  
7+0i  3.05025253169417+1.05025253169415i  2.00000000000001+-7i  12.9497474683058+-10.9497474683058i  21+0i  

代码如下:
Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
ReDim xr(0 To Len(a) - 1)
For i1 = 0 To Len(a) - 1
xr(i1) = Mid(a, i1 + 1, 1)
  Next
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double
Dim xi()
n = Len(a) '求数组大小,其值必须是2的幂
m = 0
l = 2
pi = 3.14159265358979
Do
 l = l + l
 m = m + 1
 Loop Until l > n
 n = l / 2
ReDim xi(n - 1)

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


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

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

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
2021-03-17 20:22
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
修改了一下程序,这回可能对了,哈哈哈!
程序结果: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)))
   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
  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 / 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-03-17 20:59
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
改进了一下,这回可能是正确了,删掉了最高位的非零数字,代码如下:

Private Sub Command1_Click()
Dim xr() As Double, a As String
a = Trim(Text1)
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-03-17 22:41
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
还是有问题,末尾和中间有0的时候就不对了,咋回事呢?再说吧!各位老师晚安!
11111*202=02244422(这个倒是对的),1111111111*101=022321321310(这个不对了),应该是:
1111111111*101=112,222,222,211.

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

再说吧,晚安!!

[此贴子已经被作者于2021-3-17 23:18编辑过]

2021-03-17 23:03
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
末尾有0的好处理,中间有0的好像只有101这一个数不对,其他都对?
1111111111*10001=011112222221111(这个是对的),1111111111*1001=1,112,222,222,111(这个也是对的).
哈哈哈!加个前置程序调用这个程序就可以了,前置程序可以处理末尾为0和乘数为101或两个乘数都是101的情况。当然两个都是101的不必处理,只要用普通的计算就可以,不必用大数计算程序。
2021-03-18 10:28
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
其中一个是101,只要另一个的位数不超过9位,还是对的:
111111111*101=011222222211,123456789*101=012469135689.

哈哈!就是说这个还是可以用的!
2021-03-18 10:45



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




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

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