标题:用牛顿迭代法做的快速除法程序
只看楼主
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 9楼 yuma
必须给予大整数的快速乘法基础上才能更快,数据小的没有可比性,没有大整数的快速乘法程序同样很慢。把除法转化成乘以倒数,倒数的精确度靠迭代次数保证的,精确度不是一位一位增长的,而是几位几位增长的,迭代次数小于试商次数,所以速度是快的。
小的数据是无法比较甚至更慢的,因为不管大小都需要迭代,而直接除不用迭代,小数据在计算器中有固化的程序可能是,原理不太清楚或者是转化位二进制(反正和加减法一样直接出结果的),所以反而更快(貌似试商可能原理也不是试商法),再深究我也不知道,说不清楚,等有了学会了快速乘法程序再编程比较一下就明白了。
2021-02-08 18:51
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 9楼 yuma
谢谢您关注,回复和沟通指导!祝您新年快乐!
2021-02-08 18:52
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:33
帖 子:1883
专家分:2904
注 册:2009-12-22
得分:0 
回复 11楼 ysr2857
代码的快慢目前我不敏感,数字不能高精度才是我感兴趣的。比如计算100位数字的加减乘除。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2021-02-08 18:53
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 13楼 yuma
大整数的加减法容易办到,直接模仿手工计算就行,而且可以从高位算起,当然从低位算起再道序也行,速度很快,就是直接模仿手工竖式算法就行,注意进位(或借位)的问题。乘法和除法我也仅会模仿手工计算的方法,效率低速度慢,不讲了。
把大整数的加法和减法的可调用程序发一下,仅供参考:
加法程序:
 Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function

减法程序(必须大的减去小的不输出负值):
 Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J, 1) ';每位数
For I = x To 1 Step -1  ';D1
   a(I) = Mid(d3, I, 1) ';每位数
   C1(I) = 10 + a(I) - B1(I) - 1 + JW ';计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  MPC = MPC & E1(r)
  For I = 1 To Len(MPC)
    If Not Mid(MPC, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MPC, I)
  If Len(strtmp) = 0 Then
  MPC = "0"
  Else
MPC = strtmp
End If
  Next
  
  
End Function
2021-02-08 19:14
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 13楼 yuma
这两个程序(加法和减法)都是仅仅计算整数的,要计算带小数的要移动小数点变化为整数(二者移动的位数必须相同,不够的补0),计算完再把小数点移动回去。
2021-02-08 19:20
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
大整数的乘法除法也是一样,都是计算整数的,带小数点的话要移动小数点变成整数,注意二者移动的位数。除法的话二者移动的位数要一致,都变成整数后,被除数要多补几个0根据要求的精确度补0,要求点后10位就补10个0,计算结果小数点再向前移动10位。

[此贴子已经被作者于2021-2-8 20:06编辑过]

2021-02-08 19:31
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
乘法和除法(仅仅计算整数)也发一下,速度太慢仅做参考!
乘法程序:
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-02-08 19:50
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
只输出整数部分和余数的快速除法程序,几百位的整数可以瞬间完成,最大不知道算到多少位:
(其中的乘法是模仿手工计算的速度慢,所以还有很大的提升空间)(不知道有没有错误的情况,欢迎试用和批评指导!)(修改了一下,关键是移动小数点有一类错误,已经改好,谁知道还有没有错误的类型?)

Private Sub Command1_Click() '快速除法程序
Dim a, b
  a = Trim(Text1): b = Trim(Text2): b3 = b: a3 = a
  If Len(b) = 1 Then
  X1 = Mid(b, 1, 1): X2 = 1 / X1 - 0.01
  Else
  X1 = Mid(b, 1, 2): X2 = 10 / X1 - 0.01
  End If
  x = Mid(X2, 1, 4)
  Y = 0: x3 = 0
  sb = Len(a3) + Len(b3) - 1 + 10
  If Len(a3) = Len(b3) And MBJC(Trim(a3), Trim(b3)) = 0 Then
  a1 = 1
  ElseIf MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) = 0 And Val(Len(qdhz0(Trim(a3)))) = Val(Len(b3)) Then
  a1 = 1 & String(Len(a3) - Len(qdhz0(Trim(a3))), "0")
  Else
  
  a = a & String(10, "0"): b = b & String(10 + Len(a3), "0")
  x = qdqd0(ydxsd(Trim(x), Val(sb)))
  Y1 = 2 & String(Val(sb), "0")
  Do While MBJC(MPC(Trim(x), Trim(x3)), 1) >= 0
  
  s3 = s3 + 1
  Y = mbc2(Trim(x), MPC(Trim(Y1), mbc2(Trim(b), Trim(x), Val(sb))), Val(sb))
  x3 = x
  x = Trim(Y)
  Loop
  a1 = mbc2(Trim(Y), Trim(a), Val(sb))
  s = Len(a3) - Len(b3)
  a1 = qdqd0(Trim(a1))
  
  If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) < 0 Then
  a1 = tjxsd(Trim(a1), Len(a1) - s)
  Else
  a1 = tjxsd(Trim(a1), Len(a1) - s - 1)
  End If
  End If
  
  If InStr(a1, ".") = 0 Then
  a1 = a1
  Else
  a1 = Left(a1, InStr(a1, ".") - 1)
  End If
  ja = MPC(Trim(a3), MbC(Trim(b3), Trim(a1)))
  Do While MBJC(Trim(ja), Trim(b3)) >= 0
  ja = MPC(Trim(ja), Trim(b3))
  s5 = s5 + 1
  Loop
  a1 = MPC1(Trim(a1), Trim(s5))
  If ja = 0 Then
  Text3 = a1
  Else
  Text3 = a1 & "/" & ja
  End If
  End Sub

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

  End Sub
  Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu
  Dim ja

  If Trim(sa) = 0 Or Trim(sb) = 0 Then
  mbc2 = 0
  Else


  ja = MbC(Trim(sa), Trim(sb))
  If Val(Len(ja)) > Val(sd) Then
  jb = Left(ja, Val(Len(ja)) - Val(sd))
  mbc2 = jb
  Else
  mbc2 = 0
  End If


  End If




  End Function

Private Function qdhz0(sa As String) As String
  a = sa
  Do While Right(a, 1) = "0"
  a = Left(a, Len(a) - 1)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdhz0 = a
  End Function


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

  Private Function tjxsd(sa As String, sd As String) As String
  If Val(Len(sa)) > Val(sd) Then
  tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
  Else
  If Val(Len(sa)) = Val(sd) Then
    tjxsd = "0." & sa
    Else
    tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
    End If
    End If

  End Function

  Private Function ydxsd(sa As String, sd As String) As String
  If Len(sa) = 1 And Val(sa) = 0 Then
    ydxsd = 0
    Else
   
      sc = InStr(sa, ".")
      If Val(sc) = 0 Then
      ydxsd = sa & String(sd, "0")
      Else
      se = Left(sa, Val(sc) - 1)
      sf = Right(sa, Len(sa) - Val(sc))
      If Val(Len(sf)) >= Val(sd) Then
      ydxsd = se & Mid(sf, 1, sd)
        Else
        ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
        End If
        End If
        End If
        End Function
        
        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

  Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
  Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
  D4 = String(Len(D1) - Len(D2), "0") & D2
  d3 = D1
  Else
  D4 = D2
  d3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(d3): Y = Len(D4)
  Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
  ReDim a(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim E1(1 To x)
  Dim I, J, C2, CJ, JW
  For J = Y To 1 Step -1 ';D2
  JW = 1 ';yu jie weichuzhi
  B1(J) = Mid(D4, J, 1) ';每位数
For I = x To 1 Step -1  ';D1
     a(I) = Mid(d3, I, 1) ';每位数
   C1(I) = 10 + a(I) - B1(I) - 1 + JW ';计算jia
     JW = C1(I) \ 10
     E1(I) = C1(I) Mod 10
    Next
    Next
    For r = 1 To x
    MPC = MPC & E1(r)
    For I = 1 To Len(MPC)
      If Not Mid(MPC, I, 1) = "0" Then
          Exit For
      End If
  Next
  strtmp = Mid(MPC, I)
    If Len(strtmp) = 0 Then
    MPC = "0"
    Else
  MPC = strtmp
  End If
    Next
   
   
  End Function
    Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
  Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
  D4 = String(Len(D1) - Len(D2), "0") & D2
  d3 = D1
  Else
  D4 = D2
  d3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(d3): Y = Len(D4)
  Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
  ReDim a(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim E1(1 To x)
  Dim I, J, C2, CJ, JW
  For J = Y To 1 Step -1 'D2
  JW = 0 '进位清0
  B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
     a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
     JW = C1(I) \ 10
     E1(I) = C1(I) Mod 10
    Next
    Next
    For r = 1 To x
    If JW = 0 Then
    MPC1 = MPC1 & E1(r)
    Else
    jc = jc & E1(r)
    MPC1 = JW & jc
    End If
    Next
   
  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-2-18 22:25编辑过]

2021-02-17 15:17
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:33
帖 子:1883
专家分:2904
注 册:2009-12-22
得分:0 
如果能写成计算大数,高精度的函数就好了。以后调用方便。

如:

加法函数
减法函数
乘法函数
除法函数
幂函数  如计算:107^101

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2021-02-17 17:29
ysr2857
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:767
专家分:65
注 册:2020-2-10
得分:0 
回复 19楼 yuma
这个快速除法关键是移动小数点的位置,有时候不对,差1位就差10倍呢还需要改进,确实有时候不对,比如:应该是1111111110/12345679=90,该程序不对了,结果是a4=900.0000,a1=8190/100,就是移动小数点多了1位造成的,重新考虑一下。
我有快速幂程序,代码如下:(只限于整数的整数次幂)
Private Sub Command1_Click() '快速幂程序
Dim a, b
a = Text1: b = Text2
If b = 1 Then
Text3 = a
ElseIf b = 0 Then
Text3 = 1
Else
a1 = a
Do While b > 1
s = Int(Log(b) / Log(2))
s1 = 0
Do While s1 < s
a = MbC(Trim(a), Trim(a))
s1 = s1 + 1
Loop
a2 = a
b = b - 2 ^ s
a = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If b = 1 Then
Text3 = MbC(Trim(a3), Trim(a1))
Else
Text3 = a3
End If
s3 = Len(Text3)
Text3 = Text3 & "有" & s3 & "位"
End If
End Sub

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

End Sub
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
2021-02-17 20:15



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




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

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