[Visual Basic]高精度算法

不大明白为什么今天的信息作业是抄代码……就又来写博客了

本文主要整理高精度加减乘除及其优化的模板，不做过多解释

---

高精度加法

Private Sub Command1_Click()
Dim a(1 To 100) As Integer, b(1 To 100) As Integer, c(1 To 101) As Integer
Dim s1 As String, s2 As String，s as string
Dim max As Integer, la As Integer, lb As Integer, i As Integer
s1 = Text1.Text : s2 = Text2.Text
la = Len(s1) : lb = Len(s2)
If la > lb Then max = la Else max =lb 
For i = 1 To la
a(i) = Val(Mid(s1,la-i+1,1))
Next i
For i = 1 To lb
b(i) =Val(Mid(s2,lb-i+1,1))  '1
Next i
 
For i = 1 To max
c(i) =a(i)+b(i)  '2
Next i
For i = 1 To max
c(i + 1) =c(i+1)+c(i)\10  '3
c(i) = c(i) Mod 10  '4
Next i
 
If c(max + 1) <> 0 Then  max=max+1  '5
s = ""
For i = max To 1 Step -1
s = s + Str(c(i))
Next i
Text3.Text = s
End Sub
Private Sub Command2_Click()
Text1.Text = "":Text2.Text = "":Text3.Text = ""
End Sub

优化

'从低位到高位逐位相加的过程中，边计算边进位
For i = 1 To max
    c(i + 1)=(c(i) + a(i) + b(i)) \ 10
    c(i) =(c(i) + a(i) + b(i)) Mod 10
Next i
 
'计算结果直接存储在数组a中(即a=a+b)，不再定义数组c
For i = 1 To max
    a(i + 1) =  a(i + 1) + (a(i) + b(i)) \ 10                
    a(i) =  (a(i) + b(i)) Mod 10                     
Next i
 

---

高精度减法

Dim a(1 To 100) As Integer, b(1 To 100) As Integer, c(1 To 100) As Integer
Dim s1 As String, s2 As String, t As String
Dim max As Integer, la As Integer, lb As Integer, i As Integer
s1 = Text1.Text
s2 = Text2.Text
If Len(s1) < Len(s2) Or (Len(s1) = Len(s2) And s1 < s2) Then
fh = "-"
t = s1: s1 = s2: s2 = t
End If
la = Len(s1)
lb = Len(s2)
max = la
For i = 1 To la
a(i) =Val(Mid(s1,la-i+1,1))
Next i
For i = 1 To lb
b(i) = Val(Mid(s1,lb-i+1,1))
Next i
For i = 1 To max
If a(i) >= b(i) Then
c(i) = a(i)-b(i)   '1
Else
c(i) =10+a(i)-b(i)   '2
a(i+1)=a(i+1)+1   '3
End If
Next i
Do While c(max) = 0
max=max-1   '4
Loop
If fh = "-" Then s = "-" Else s = ""
For i = max To 1 Step -1
s = s + Str(c(i))
Next i
Text3.Text = s
End Sub

---

高精度乘法

大数*小数

Private Sub Command1_Click()
Dim a(1 To 100) As Integer, b As Long
Dim s1 As String, la As Integer, i As Integer
s1 = Text1.Text
b = Val(Text2.Text)
If s1 = "0" Or b = 0 Then
  Text3.Text = "0"
Else
la = Len(s1)
For i = 1 To la
   a(i) = Val(Mid(s1, la - i + 1, 1))
Next i
 
For i = 1 To la ‘从a(1)到a(La)逐位与b相乘
   a(i) = a(i)*b   '1
Next i
For i = 1 To la ‘从低位到高位进位处理
   a(i + 1) = a(i+1)+a(i)/10   '2
   a(i) = a(i) Mod 10
Next i
c = a(la + 1) ‘确定结果的位数和新增位上的值
Do While c > 0
  la = la+1   '3
  a(la) = c Mod 10
  c = c \ 10
Loop
 
s = ""
For i = la To 1 Step -1
s = s + Str(a(i))
Next i
Text3.Text = s
End If
End Sub

优化

For i = 1 To la
   a(i) = a(i) * b + c
   c = a(i)\10   '1
   a(i) = a(i) Mod 10   '2
Next i
Do While c > 0
  la = la+1   '3
  a(la) = c Mod 10
  c = c \ 10
Loop

大数*大数

Private Sub Command1_Click()
Dim a(1 To 100) As Integer, b(1 To 100) As Integer, c(1 To 200) As Integer
Dim s1 As String, s2 As String
Dim max As Integer, la As Integer, lb As Integer, i As Integer, t As Integer
s1 = Text1.Text
s2 = Text2.Text
la = Len(s1)
lb = Len(s2)
max = la + lb
For i = 1 To la
a(i) = Val(Mid(s1, la - i + 1, 1))
Next i
For i = 1 To lb
b(i) = Val(Mid(s2, lb - i + 1, 1))
Next i
For i = 1 To la
 For j = 1 To lb
   c(i + j - 1) = c(i+j-1)+a(i)*b(j)   '1
 Next j
Next i
For i = 1 To max
If c(i) >= 10 Then
c(i + 1) = c(i+1)+c(i)\10   '2
c(i) = c(i) Mod 10    '3
End If
Next i
If c(max)=0 Then max = max - 1   '4
s = ""
For i = max To 1 Step -1
s = s + Str(c(i))
Next i
Text3.Text = s
End Sub

---

高精度除法

Dim s1 As String, s2 As String, s3 As String, s As String, ans As String
Dim tot As Integer, t As Integer
Private Sub Command1_Click()
Dim a As Integer, b As Integer, length As Integer， i As Integer, j As Integer
s1 = Text1.Text：s2 = Text2.Text
s3 = ""
length = Len(s1) - Len(s2)
For i = 1 To length
s2 = s2 + "0"
Next i
For i = 0 To length
s = Mid(s2, 1, Len(s2) - i)
tot = 0
Do While len(s1)>len(s) Or Len(s1) = Len(s) And s1 >= s   '1
tot = tot + 1
ans = ""
flag = False
a = Len(s1): b = Len(s)
For j = a To 1 Step -1
t = 0
If flag Then
t = -1
flag = False
End If
If b > 0 Then
t = t + Val(Mid(s1, j, 1)) - Val(Mid(s, b, 1))
Else
t = t + Val(Mid(s1,j,1))   '2
End If
If t < 0 Then
t=10+t   '3
flag = True
End If
ans = t & ans
b = b - 1
Next j
s1 = Val(ans)
Loop
s3 = s3 & tot
Next i
i = 1
Do While Mid(s3, i, 1) = "0"
i = i + 1
Loop
Text3.Text = Mid(s3, i, Len(s3))
End Sub