|
|
楼主 |
发表于 2023-1-13 20:19
|
显示全部楼层
本帖最后由 ysr 于 2023-1-13 22:49 编辑
Private Sub Command1_Click()
'验证李明波幂和猜想的程序
Dim a, B
a = Val(Text1)
B = Val(Text2)
a1 = a
Do While a <= B
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop
r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text3 = Text3 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a4 = a - Int(q) ^ 2 - Int(q1) ^ 2
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & a2 & "^" & r1 & vbCrLf
ElseIf a4 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^" & 2 & "+1" & vbCrLf
Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If a4 = 2 Then
js = ksm6(Trim(a), Val(s))
If InStr(js, "+") = 0 Then
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
Else
Text3 = Text3 & js & vbCrLf
End If
ElseIf InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^2+" & a2 & "^" & r2 & vbCrLf
Else
js = ksm6(Trim(a), Val(s))
If InStr(js, "+") = 0 Then
a4 = a - 1
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop
r1 = Log(a4) / Log(a2)
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & "1+" & a2 & "^" & r1 & vbCrLf
Else
a5 = a - 2
a2 = 2
Do While InStr(Log(a5) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop
r2 = Log(a5) / Log(a2)
If InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & "1+1+" & a2 & "^" & r2 & vbCrLf
Else
ja1 = 2
jc = ksm5(Trim(a), Trim(q))
If InStr(jc, "无解") > 0 Then
js1 = 1
ja = 3
Do While js1 < a ^ (1 / ja)
Do While ja < a ^ (1 / ja)
ax = Abs(a - js1 ^ ja)
js2 = js1 & "^" & ja
jss = ksm7(Val(ax), Trim(js2))
If InStr(jss, "无解") = 0 Then
s1 = s1 + 1
jss1 = jss1 & a & "=" & jss & vbclf
Else
jss1 = jss1 & vbCrLf
End If
ja = ja + 1
Loop
js1 = js1 + 1
Loop
If s1 > 0 Then
Text3 = Text3 & jss1 & vbCrLf
Else
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
End If
Else
Text3 = Text3 & jc & vbCrLf
End If
End If
End If
Else
Text3 = Text3 & js & vbCrLf
End If
End If
End If
End If
a = a + 1
Loop
Combo1 = a1 & "~" & B & "之间，有" & Val(s) & "个无解：" & vbCrLf & Text3
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""
End Sub
Private Function ksm7(sa As String, sb As String) As String '某数的快速幂程序
Dim a, q
a = Val(sa)
qr = Trim(sb)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < a ^ (1 / 2)
a2 = a2 + 1
Loop
r1 = Log(a) / Log(a2)
a4 = a - a2 ^ Int(r1)
If InStr(r1, ".") = 0 Then
s1 = s1 + 1
jss = jss & qr & "+" & a2 & "^" & r1 & vbCrLf
ElseIf a4 = 1 Then
jss = jss & qr & "+" & a2 & "^" & Int(r1) & "+1" & vbCrLf
Else
js1 = 1
ja = 3
Do While js1 < a ^ (1 / ja)
Do While ja < a ^ (1 / ja)
a1 = Abs(a - js1 ^ ja)
If InStr(fenjieyinzi(Val(ja)), "*") = 0 Then
a2 = 2
Do While InStr(Log(a1) / Log(a2), ".") > 0 And a2 < a1 ^ (1 / 2)
a2 = a2 + 1
Loop
r = Log(a1) / Log(a2)
If Val(r) = 0 Then
jss = jss & qr & "+" & js1 & "^" & ja & "+" & "1 " & vbclf
s1 = s1 + 1
ElseIf InStr(r, ".") = 0 Then
s1 = s1 + 1
jss = jss & qr & "+" & js1 & "^" & ja & "+" & a2 & "^" & r & vbclf
Else
jss1 = "无解" & vbCrLf
End If
Else
jss = jss & vbCrLf
End If
ja = ja + 1
Loop
js1 = js1 + 1
Loop
End If
If s1 > 0 Then
ksm7 = jss & vbCrLf
Else
ksm7 = ksm7 & a & "=无解" & vbCrLf
End If
End Function
Private Function fenjieyinzi(sa As String) As String
Dim X, a, B
X = sa
B = Int(Sqr(Val(X)) / 2)
If X = 3 Or X = 2 Then
a = True
Else
If Right(X, 1) Mod 2 = 0 Then
a = False
Else
For i = 3 To 2 * B + 1 Step 2
If InStr(X / i, ".") = 0 Then
a = False
Exit For
Else: a = True
End If
Next
End If
End If
If a = True Then
fenjieyinzi = "这是个素数"
Else
fenjieyinzi = "2*2"
End If
End Function
|
|
IP卡
狗仔卡
显身卡