|
|
快速程序出来了，9位以内的勾股数都可以，超过9位就失效了。对a+b=163500169验证了一下，几分钟就出来结果，结果是正确的，就是364组解。
代码如下:
Private Sub Command1_Click()
Dim x, Y, z
m = Text2
x = 1
Do While x < Val(m) / 2 + 1
Y = Val(m) - x
z = Sqr(x ^ 2 + Y ^ 2)
If InStr(z, ".") = 0 Then
If MPC(MPC1(MbC(Trim(x), Trim(x)), MbC(Trim(Y), Trim(Y))), MbC(Trim(z), Trim(z))) = 0 Then
s = s & "/解/" & x & "/" & Y & "/" & z
s1 = s1 + 1
Else
s1 = s1
End If
Else
s1 = s1
End If
x = x + 1
Loop
Text1 = Text1 & "有" & s1 & "组解： " & s
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
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
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 |
|
[复制链接]
IP卡
狗仔卡
发表于 2021-2-15 17:17
显身卡