论坛 › www.fea-league.com › [原创]大整数的乘法

ysr 发表于 2021-4-5 08:01

101000与102000之间的素数打头有0组差为2和10和2的4生素数对: (用时1.076172秒）

ysr 发表于 2021-4-5 08:08

112000与115000之间的素数打头有1组差为2和10和2的4生素数对: (用时3.257813秒）
/113147/113149/113159/113161

ysr 发表于 2021-4-5 12:56

本帖最后由 ysr 于 2021-5-6 05:42 编辑

Private Function zhengchuqyushu(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqyushu = 0
Else
zhengchuqyushu = Mid(sa, InStr(sa, "/") + 1)
End If


End Function


Private Function zhengchuqy(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If


End Function


Public Function MBBC(D1 As String) As String 'kai pingfang
If Len(D1) < 10 Then
jss = Int(Sqr(D1))
JW = Val(D1) - (jss) ^ 2
If JW = 0 Then
MBBC = jss
Else
MBBC = jss & "/" & JW
    End If
Else
Dim X 'shuju changdu
X = Len(D1) \ 4
D2 = String(4 - Len(D1) + 4 * X, "0") & D1
Dim A() As String
ReDim A(4 To 4 * X + 4)
Dim B() As String
ReDim B(2 To 2 * X)
Dim I, J, js
For I = 4 To 4 * X + 4 Step 4

A(I) = Mid(D2, I - 3, 4)
js = Int(Sqr(Val(A(4) & A(8))))
JW = Val(A(4) & A(8)) - (js) ^ 2
Next
   J = 4
   Do While J <= 2 * X
   
   jws = MPC1(JW & "0000", A(2 * J + 4))
   If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then
    B(J) = "00"
    Else
    jwc = Left(jws, Len(jws) - Len(MbC(Trim(js), 200)) + 2) \ Left(MbC(Trim(js), 200), 2)
    If Len(jwc) > 2 Then
   B(J) = 99
   Else
   B(J) = jwc
   End If
   
   
   Do While MBJC(Trim(jws), MbC(MPC1(B(J), MbC(Trim(js), 200)), B(J))) = -1
   
   B(J) = B(J) - 1
   
               Loop
          End If
          JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), B(J)), B(J)))
      
   js = MPC1(MbC(Trim(js), 100), Trim(B(J)))
   
      
   J = J + 2
   If JW = 0 Then
      
   MBBC = js
   Else
   MBBC = js & "/" & JW
   End If
   Loop
   
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

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

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 MbC(D1 As String, D2 As String) As String
Dim X, Y ';两数长度
X = Len(D1) \ 4: Y = Len(D2) \ 4
D3 = String(4 * X + 4 - Len(D1), "0") & D1
D4 = String(4 * Y + 4 - Len(D2), "0") & D2
X = X + 1: Y = Y + 1
Dim A() As String
ReDim A(4 To 4 * X + 4 * Y, 4 To 4 * Y)
Dim I, J, C1, C2, CJ, JW, s, t
For J = 4 * Y To 4 Step -4 ';D2
JW = 0 ';进位清0
C2 = Mid(D4, J - 3, 4) ';每位数
For I = 4 * X To 4 Step -4 ';D1
C1 = Mid(D3, I - 3, 4) ';每位数
CJ = Val(C1) * Val(C2) + JW ';计算乘积
c = I + J: r = 4 * Y + 4 - J
A(c, r) = String(4 - Len(CJ Mod 10000), "0") & CJ Mod 10000 ';本位
JW = CJ \ 10000 ';进位
Next
A(c - 4, r) = JW
Next
Dim B() As String
ReDim B(1 To X + Y)
JW = 0
For s = X + Y To 1 Step -1
Bit = JW
For t = 1 To Y
Bit = Bit + Val(A(4 * s, 4 * t))
Next
B(s) = String(4 - Len(Bit Mod 10000), "0") & Bit Mod 10000
JW = Bit \ 10000
Next
If B(1) > 0 Then
MbC = Val(Left(MbC, 5)) & Mid(MbC, 6) & B(1)
Else
MbC = Val(Left(MbC, 5)) & Mid(MbC, 6)
End If
For s = 2 To X + Y
MbC = Val(Left(MbC, 5)) & Mid(MbC, 6) & B(s)
Next
End Function

'该程序已经做了修改，不是去掉前导0的问题，是补够前导0的问题。


Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim X, Y ';两数长度
If qqdl(D2) = "0" Then
MPC = D1
Else
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) \ 8: Y = Len(D4) \ 8
D3 = String(8 * X + 8 - Len(D3), "0") & D3
D4 = String(8 * Y + 8 - Len(D4), "0") & D4
X = X + 1: Y = Y + 1

Dim A() As String, B1() As String, C1() As String, E1() As String
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 * 8 - 7, 8) ';每位数
For I = X To 1 Step -1';D1
   A(I) = Mid(D3, I * 8 - 7, 8) ';每位数
   C1(I) = Val(1 & A(I)) - Val(B1(I)) - Val(1) + Val(JW) ';计算jia
   If Len(C1(I)) <= 8 Then
   JW = 0
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
   JW = Left(C1(I), Len(C1(I)) - 8)
   End If
   E1(I) = Right(C1(I), 8)
   If Len(E1(I)) < 8 Then
   E1(I) = String(8 - Len(E1(I)), "0") & E1(I)
   Else
   E1(I) = E1(I)
   End If
   
    Next
    Next
    For r = 1 To X
    MPC = MPC & E1(r)
    If Len(MPC) > Len(D1) Then
    MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
    Else
    MPC = MPC
    End If
    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 If
   
End Function

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim X, Y, JW '两数长度

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) \ 8: Y = Len(D4) \ 8
If 8 * X < Len(D3) Then
D3 = String(8 * X + 8 - Len(D3), "0") & D3
D4 = String(8 * Y + 8 - Len(D4), "0") & D4
X = X + 1: Y = Y + 1
Else
X = X: Y = Y
D3 = D3: D4 = D4
End If
Dim A() As String, B1() As String, C1() As String, E1() As String
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
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J * 8 - 7, 8) '每位数
For I = X To 1 Step -1'D1
   A(I) = Mid$(D3, I * 8 - 7, 8) '每位数
   C1(I) = Val(A(I)) + Val(B1(I)) + Val(JW) '计算jia
   If Len(C1(I)) < 8 Then
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
   C1(I) = C1(I)
   End If
   JW = Left(C1(I), Len(C1(I)) - 8)
   E1(I) = Right(C1(I), 8)
    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
   MPC1 = qqdl(Trim(MPC1))
End Function

Private Function qqdl(sa As String) As String


For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
      Exit For
    End If
Next
strTmp = Mid(sa, I)
If Len(strTmp) = 0 Then
qqdl = "0"
Else
qqdl = strTmp
End If
End Function


Private Function zzxc(sa As String, sb As String) As String
Dim A, B, c, d, r
A = Trim(sa)
B = Trim(sb)
If Len(A) < 10 And Len(B) < 10 Then

If Val(A) > Val(B) Then
   c = A
   d = B
Else
   c = B
   d = A
End If
Do Until Val(c) Mod Val(d) = 0
   r = c Mod d
   c = d
   d = r
Loop

Else

If MBJC(Trim(A), Trim(B)) >= 1 Then
c = A
d = B
Else
c = B
d = A
End If
Do Until zhengchuqyushu(MCC1(Trim(c), Trim(d))) = 0
r = zhengchuqyushu(MCC1(Trim(c), Trim(d)))
c = d
d = r
Loop
End If


zzxc = d

End Function

Private Function qniyuan(sa As String, sb As String) As String
Dim n, p, A, B, c, d, r
n = Trim(sa)
p = Trim(sb)
A = 1
B = 0
c = 0
d = 1
If Len(n) < 10 And Len(p) < 10 Then

If Val(n) > Val(p) Then
   m = n
   q = p
   s1 = 1
Else
   m = p
   q = n
   s1 = 0
End If
Do Until Val(m) Mod Val(q) = 0
    s = m \ q
   r = m Mod q
   s1 = s1 + 1
   If s1 Mod 2 = 1 Then
   A = A
   B = A * s + B
   c = c
   d = c * s + d
   Else
   B = B
   A = A + B * s
   d = d
   c = c + d * s
   End If
   m = q
   q = r
Loop
If Val(A + B * m) = p Then
B = B
A = A + B * (m - 1)
d = d
c = c + d * (m - 1)
Else
If Val(B + A * m) = p Then
A = A
B = B + A * m
c = c
d = d + c * m
Else
B = B
A = A + B * (m - 1)
d = d
c = c + d * (m - 1)
End If
End If
X = (A + B) Mod p
Y = (c + d) Mod n


Else

If MBJC(Trim(n), Trim(p)) >= 1 Then
m = n
q = p
s1 = 1
Else
m = p
q = n
s1 = 0
End If
Do Until zhengchuqyushu(MCC1(Trim(m), Trim(q))) = 0
s = zhengchuqy(MCC1(Trim(m), Trim(q)))
r = zhengchuqyushu(MCC1(Trim(m), Trim(q)))
s1 = s1 + 1
If s1 Mod 2 = 1 Then
A = A
B = MPC1(MbC(Trim(A), Trim(s)), Trim(B))
c = c
d = MPC1(MbC(Trim(c), Trim(s)), Trim(d))
Else
B = B
A = MPC1(Trim(A), MbC(Trim(B), Trim(s)))
d = d
c = MPC1(Trim(c), MbC(Trim(d), Trim(s)))
End If

m = q
q = r
Loop

If MPC1(Trim(A), MbC(Trim(B), Trim(m))) = p Then
B = B
A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
d = d
c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
Else
If MPC1(Trim(B), MbC(Trim(A), Trim(m))) = p Then
A = A
B = MPC1(Trim(B), MbC(Trim(A), Trim(m)))
c = c
d = MPC1(Trim(d), MbC(Trim(c), Trim(m)))
Else
B = B
A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
d = d
c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
End If
End If
Do While Left(A, 1) = "0"
    A = Mid(A, 2)
Loop

End If

qniyuan = A
End Function

Private Function qksmimo(sa As String, sb As String, sc As String) As String
Dim c, e, n, d
c = Trim(sa)
e = Trim(sb)
n = Trim(sc)
d = 1
If Len(c) < 5 And Len(e) < 5 And Len(n) < 5 Then
c = Val(c): n = Val(n)
Do While e > 0
If Right(e, 1) Mod 2 = 0 Then
c = c * c Mod n
e = e / 2

Else
d = d * c Mod n
e = e - 1
End If
Loop
Else
c = c
Do While MBJC(Trim(e), 1) >= 0
If Right(e, 1) Mod 2 = 0 Then
c = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(c)), Trim(n)))
e = zhengchuqy(MCC1(Trim(e), 2))
Else
d = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(d)), Trim(n)))
e = MPC(Trim(e), 1)
End If
Loop
End If

qksmimo = d
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 X Mod 2 = 0 Then
A = False
Else

For I = 3 To 2 * B + 1 Step 2
If X Mod 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


Private Sub Command1_Click() '求由2个孪生素数对组成的4生素数组的程序
Dim A, B
A = Val(Text1)
a1 = A
q = Val(Text2)
m = Sqr(q)
t = Trim(Text4)
ts = Timer
If Right(A, 1) Mod 2 = 0 Then
A = A + 1
Else
A = A
End If
s = 0
a3 = A
a2 = a3 + 2
Do While a2 <= m
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0 Or InStr(fenjieyinzi0(Trim(a3)), "*") > 0
a3 = a2 + 2
a2 = a3 + 2
Loop
B1 = a2
B2 = MPC1(Trim(B1), Trim(t))
b3 = MPC1(Trim(B2), 2)
C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Trim(B2))
C3 = fenjieyinzi0(Trim(b3))
If InStr(C1, "*") = 0 And InStr(C2, "*") = 0 And InStr(C3, "*") = 0 Then
s = s + 1
Print B1, B2
Text3 = Text3 & "/" & a3 & "/" & B1 & "/" & B2 & "/" & b3 & vbCrLf
Else
s = s
End If
a2 = a2 + 2

Loop

s1 = s
Do While a2 <= q
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0 Or InStr(fenjieyinzi0(Trim(a3)), "*") > 0
a3 = a2 + 2
a2 = a3 + 2
Loop
B1 = a2
B2 = MPC1(Trim(B1), Trim(t))
b3 = MPC1(Trim(B2), 2)
C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Trim(B2))
C3 = fenjieyinzi0(Trim(b3))
If InStr(C1, "*") = 0 And InStr(C2, "*") = 0 And InStr(C3, "*") = 0 Then
s1 = s1 + 1
Print B1, B2
Text3 = Text3 & "/" & a3 & "/" & B1 & "/" & B2 & "/" & b3 & vbCrLf
Else
s1 = s1
End If
a2 = a2 + 2

Loop
Combo1 = a1 & "与" & q & "之间的素数打头有" & s1 & "组差为2和" & t & "和2的4生素数对: (用时" & Timer - ts & "秒）" & vbCrLf & Text3

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Combo1 = ""
Form1.Cls
End Sub

Private Function fenjieyinzi0(sa As String) As String
Dim A, n
n = Trim(sa)
If Len(n) < 6 Then
fenjieyinzi0 = fenjieyinzi(Trim(n))
Else
n1 = MPC(Trim(n), 1)
A = 123
'a为明文
a1 = zzxc(Trim(n), Trim(A))
If Val(a1) > 1 Then
fenjieyinzi0 = a1 & "*"
Else
c = 999
'c为公约
Do While zzxc(Trim(n1), Trim(c)) > 1
c = Val(c - 1)
Loop
d = qniyuan(Trim(c), Trim(n1))
'd为逆元为私钥
a2 = qksmimo(Trim(A), Trim(c), Trim(n))
'a2为密文
a3 = qksmimo(Trim(a2), Trim(d), Trim(n))
If MBJC(Trim(a3), Trim(A)) = 0 Then
fenjieyinzi0 = "这是素数有"
Else
fenjieyinzi0 = "2*2"
End If
End If
End If


End Function

'发一下这个程序，几十位以内还是快的，超过100位就慢了。

ysr 发表于 2021-4-5 20:24

2333333333333333333353~2333333333333333333373之间的素数有1个：（用时6.15625秒）
2333333333333333333369.该素数有22位.
程序速度提高不少，但与高手编的程序差距肯定不小，继续努力吧！

ysr 发表于 2021-4-7 20:40

1与10之间有1组差为13916000003349999997294的2生素数对:（用时2.195313秒）
/3/13916000003349999997297

ysr 发表于 2021-4-7 21:11

1与10000之间打头的素数有36组偶数13916000003349999997294的哥猜素数和对:（用时942.5547秒）
/683/13916000003349999996611
/701/13916000003349999996593
/971/13916000003349999996323
/977/13916000003349999996317
/1103/13916000003349999996191
/1481/13916000003349999995813
/1613/13916000003349999995681
/1811/13916000003349999995483
/2081/13916000003349999995213
/2207/13916000003349999995087
/2297/13916000003349999994997
/2423/13916000003349999994871
/2927/13916000003349999994367
/2963/13916000003349999994331
/3137/13916000003349999994157
/3617/13916000003349999993677
/3923/13916000003349999993371
/4547/13916000003349999992747
/4583/13916000003349999992711
/4643/13916000003349999992651
/5003/13916000003349999992291
/5261/13916000003349999992033
/5303/13916000003349999991991
/5471/13916000003349999991823
/5591/13916000003349999991703
/5927/13916000003349999991367
/6491/13916000003349999990803
/6983/13916000003349999990311
/7127/13916000003349999990167
/7883/13916000003349999989411
/8447/13916000003349999988847
/8543/13916000003349999988751
/8831/13916000003349999988463
/8951/13916000003349999988343
/9203/13916000003349999988091
/9497/13916000003349999987797

ysr 发表于 2021-4-7 21:56

本帖最后由 ysr 于 2021-4-7 14:14 编辑

10000与30000之间打头的素数有52组偶数13916000003349999997294的哥猜素数和对:（用时1736.828秒）
/10193/13916000003349999987101
/10211/13916000003349999987083
/11057/13916000003349999986237
/11273/13916000003349999986021
/11777/13916000003349999985517
/12791/13916000003349999984503
/12911/13916000003349999984383
/14081/13916000003349999983213
/14177/13916000003349999983117
/14303/13916000003349999982991
/14891/13916000003349999982403
/15107/13916000003349999982187
/15443/13916000003349999981851
/15551/13916000003349999981743
/16007/13916000003349999981287
/16073/13916000003349999981221
/16217/13916000003349999981077
/16811/13916000003349999980483
/16931/13916000003349999980363
/17033/13916000003349999980261
/17123/13916000003349999980171
/17327/13916000003349999979967
/18131/13916000003349999979163
/18341/13916000003349999978953
/18461/13916000003349999978833
/18713/13916000003349999978581
/19433/13916000003349999977861
/19463/13916000003349999977831
/20177/13916000003349999977117
/20261/13916000003349999977033
/20681/13916000003349999976613
/21347/13916000003349999975947
/21563/13916000003349999975731
/21647/13916000003349999975647
/22157/13916000003349999975137
/22727/13916000003349999974567
/22961/13916000003349999974333
/23417/13916000003349999973877
/24473/13916000003349999972821
/24533/13916000003349999972761
/24671/13916000003349999972623
/25523/13916000003349999971771
/25793/13916000003349999971501
/26183/13916000003349999971111
/26513/13916000003349999970781
/26591/13916000003349999970703
/26717/13916000003349999970577
/27941/13916000003349999969353
/28163/13916000003349999969131
/28961/13916000003349999968333
/29363/13916000003349999967931
/29837/13916000003349999967457
（也就是，在30000内的素数打头，能构成52+36=88对，偶数13916000003349999997294的哥德巴赫猜想素数和对，据此能估算出该偶数的哥德巴赫猜想解的总个数大约是多少吗？）

ysr 发表于 2021-4-7 22:04

13916000003349999997294/2=6,958,000,001,674,999,998,647，6,958,000,001,674,999,998,647/30000*88=20,410,133,338,246,666,662.697866666667.
这个就是估计值，应该是上限，可能是上限，仅仅是可能性。
这样做是不准确的。

ysr 发表于 2021-4-7 22:08

本帖最后由 ysr 于 2021-6-3 08:38 编辑

'下面发一下这个程序，速度还可以：

Private Function zhengchuqyushu(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqyushu = 0
Else
zhengchuqyushu = Mid(sa, InStr(sa, "/") + 1)
End If


End Function


Private Function zhengchuqy(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If


End Function


Public Function MBBC(D1 As String) As String 'kai pingfang
If Len(D1) < 10 Then
jss = Int(Sqr(D1))
JW = Val(D1) - (jss) ^ 2
If JW = 0 Then
MBBC = jss
Else
MBBC = jss & "/" & JW
    End If
Else
Dim x 'shuju changdu
x = Len(D1) \ 4
D2 = String(4 - Len(D1) + 4 * x, "0") & D1
Dim A() As String
ReDim A(4 To 4 * x + 4)
Dim B() As String
ReDim B(2 To 2 * x)
Dim I, J, js
For I = 4 To 4 * x + 4 Step 4

A(I) = Mid(D2, I - 3, 4)
js = Int(Sqr(Val(A(4) & A(8))))
JW = Val(A(4) & A(8)) - (js) ^ 2
Next
   J = 4
   Do While J <= 2 * x
   
   jws = MPC1(JW & "0000", A(2 * J + 4))
   If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then
    B(J) = "00"
    Else
    jwc = Left(jws, Len(jws) - Len(MbC(Trim(js), 200)) + 2) \ Left(MbC(Trim(js), 200), 2)
    If Len(jwc) > 2 Then
   B(J) = 99
   Else
   B(J) = jwc
   End If
   
   
   Do While MBJC(Trim(jws), MbC(MPC1(B(J), MbC(Trim(js), 200)), B(J))) = -1
   
   B(J) = B(J) - 1
   
               Loop
          End If
          JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), B(J)), B(J)))
      
   js = MPC1(MbC(Trim(js), 100), Trim(B(J)))
   
      
   J = J + 2
   If JW = 0 Then
      
   MBBC = js
   Else
   MBBC = js & "/" & JW
   End If
   Loop
   
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

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

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 MbC(D1 As String, D2 As String) As String
Dim j1&, j2&, e&, d&, e1&, m, n

   ' 按列法计算C=A*B
m = Trim(D1): n = Trim(D2)
x = Len(m) \ 4: Y = Len(n) \ 4
m = String(4 * x + 4 - Len(m), "0") & m
n = String(4 * Y + 4 - Len(n), "0") & n
x = x + 1: Y = Y + 1
Dim A(), B()
ReDim A(1 To x): ReDim B(1 To Y)
For i1 = 1 To x
A(i1) = Val(Mid(m, i1 * 4 - 3, 4))
Next
For i2 = 1 To Y
B(i2) = Val(Mid(n, i2 * 4 - 3, 4))
Next
ma = x: mb = Y
    MC = ma + mb
    ReDim c(MC)
    e1 = 0
    j1 = ma: j2 = ma
    For I = MC To 2 Step -1
      If I <= ma Then j2 = I - 1
      e = e1: e1 = 0
      For J = j1 To j2
            e = e + A(J) * B(I - J)
            If e > 2040000000 Then '减少进位次数
                e = e - 2040000000
                e1 = e1 + 204000
            End If
      Next J

      If j1 > 1 Then j1 = j1 - 1
base = 10000
      d = e \ base
      c(I) = e - d * base
      If Len(c(I)) < 4 Then
      c(I) = String(4 - Len(c(I)), "0") & c(I)
      Else
      c(I) = c(I)
      End If
jc = c(I) & jc
      e1 = e1 + d
    Next I
    jc = d & jc
   MbC = qqdl(Trim(jc))
End Function

'该程序已经做了修改，不是去掉前导0的问题，是补够前导0的问题。


Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If qqdl(D2) = "0" Then
MPC = D1
Else
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) \ 8: Y = Len(D4) \ 8
D3 = String(8 * x + 8 - Len(D3), "0") & D3
D4 = String(8 * Y + 8 - Len(D4), "0") & D4
x = x + 1: Y = Y + 1

Dim A() As String, B1() As String, C1() As String, e1() As String
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 * 8 - 7, 8) ';每位数
For I = x To 1 Step -1';D1
   A(I) = Mid(D3, I * 8 - 7, 8) ';每位数
   C1(I) = Val(1 & A(I)) - Val(B1(I)) - Val(1) + Val(JW) ';计算jia
   If Len(C1(I)) <= 8 Then
   JW = 0
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
   JW = Left(C1(I), Len(C1(I)) - 8)
   End If
   e1(I) = Right(C1(I), 8)
   If Len(e1(I)) < 8 Then
   e1(I) = String(8 - Len(e1(I)), "0") & e1(I)
   Else
   e1(I) = e1(I)
   End If
   
    Next
    Next
    For r = 1 To x
    MPC = MPC & e1(r)
    If Len(MPC) > Len(D1) Then
    MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
    Else
    MPC = MPC
    End If
    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 If
   
End Function

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y, JW '两数长度

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) \ 8: Y = Len(D4) \ 8
If 8 * x < Len(D3) Then
D3 = String(8 * x + 8 - Len(D3), "0") & D3
D4 = String(8 * Y + 8 - Len(D4), "0") & D4
x = x + 1: Y = Y + 1
Else
x = x: Y = Y
D3 = D3: D4 = D4
End If
Dim A() As String, B1() As String, C1() As String, e1() As String
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
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J * 8 - 7, 8) '每位数
For I = x To 1 Step -1'D1
   A(I) = Mid$(D3, I * 8 - 7, 8) '每位数
   C1(I) = Val(A(I)) + Val(B1(I)) + Val(JW) '计算jia
   If Len(C1(I)) < 8 Then
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
   C1(I) = C1(I)
   End If
   JW = Left(C1(I), Len(C1(I)) - 8)
   e1(I) = Right(C1(I), 8)
    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
   MPC1 = qqdl(Trim(MPC1))
End Function

Private Function qqdl(sa As String) As String


For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
      Exit For
    End If
Next
strTmp = Mid(sa, I)
If Len(strTmp) = 0 Then
qqdl = "0"
Else
qqdl = strTmp
End If
End Function


Private Function zzxc(sa As String, sb As String) As String
Dim A, B, c, d, r
A = Trim(sa)
B = Trim(sb)
If Len(A) < 10 And Len(B) < 10 Then

If Val(A) > Val(B) Then
   c = A
   d = B
Else
   c = B
   d = A
End If
Do Until Val(c) Mod Val(d) = 0
   r = c Mod d
   c = d
   d = r
Loop

Else

If MBJC(Trim(A), Trim(B)) >= 1 Then
c = A
d = B
Else
c = B
d = A
End If
Do Until zhengchuqyushu(MCC1(Trim(c), Trim(d))) = 0
r = zhengchuqyushu(MCC1(Trim(c), Trim(d)))
c = d
d = r
Loop
End If


zzxc = d

End Function

Private Function qniyuan(sa As String, sb As String) As String
Dim n, p, A, B, c, d, r
n = Trim(sa)
p = Trim(sb)
A = 1
B = 0
c = 0
d = 1
If Len(n) < 10 And Len(p) < 10 Then

If Val(n) > Val(p) Then
   m = n
   q = p
   s1 = 1
Else
   m = p
   q = n
   s1 = 0
End If
Do Until Val(m) Mod Val(q) = 0
    s = m \ q
   r = m Mod q
   s1 = s1 + 1
   If s1 Mod 2 = 1 Then
   A = A
   B = A * s + B
   c = c
   d = c * s + d
   Else
   B = B
   A = A + B * s
   d = d
   c = c + d * s
   End If
   m = q
   q = r
Loop
If Val(A + B * m) = p Then
B = B
A = A + B * (m - 1)
d = d
c = c + d * (m - 1)
Else
If Val(B + A * m) = p Then
A = A
B = B + A * m
c = c
d = d + c * m
Else
B = B
A = A + B * (m - 1)
d = d
c = c + d * (m - 1)
End If
End If
x = (A + B) Mod p
Y = (c + d) Mod n


Else

If MBJC(Trim(n), Trim(p)) >= 1 Then
m = n
q = p
s1 = 1
Else
m = p
q = n
s1 = 0
End If
Do Until zhengchuqyushu(MCC1(Trim(m), Trim(q))) = 0
s = zhengchuqy(MCC1(Trim(m), Trim(q)))
r = zhengchuqyushu(MCC1(Trim(m), Trim(q)))
s1 = s1 + 1
If s1 Mod 2 = 1 Then
A = A
B = MPC1(MbC(Trim(A), Trim(s)), Trim(B))
c = c
d = MPC1(MbC(Trim(c), Trim(s)), Trim(d))
Else
B = B
A = MPC1(Trim(A), MbC(Trim(B), Trim(s)))
d = d
c = MPC1(Trim(c), MbC(Trim(d), Trim(s)))
End If

m = q
q = r
Loop

If MPC1(Trim(A), MbC(Trim(B), Trim(m))) = p Then
B = B
A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
d = d
c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
Else
If MPC1(Trim(B), MbC(Trim(A), Trim(m))) = p Then
A = A
B = MPC1(Trim(B), MbC(Trim(A), Trim(m)))
c = c
d = MPC1(Trim(d), MbC(Trim(c), Trim(m)))
Else
B = B
A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
d = d
c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
End If
End If
Do While Left(A, 1) = "0"
    A = Mid(A, 2)
Loop

End If

qniyuan = A
End Function

Private Function qksmimo(sa As String, sb As String, sc As String) As String
Dim c, e, n, d
c = Trim(sa)
e = Trim(sb)
n = Trim(sc)
d = 1
If Len(c) < 5 And Len(e) < 5 And Len(n) < 5 Then
c = Val(c): n = Val(n)
Do While e > 0
If Right(e, 1) Mod 2 = 0 Then
c = c * c Mod n
e = e / 2

Else
d = d * c Mod n
e = e - 1
End If
Loop
Else
c = c
Do While MBJC(Trim(e), 1) >= 0
If Right(e, 1) Mod 2 = 0 Then
c = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(c)), Trim(n)))
e = zhengchuqy(MCC1(Trim(e), 2))
Else
d = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(d)), Trim(n)))
e = MPC(Trim(e), 1)
End If
Loop
End If

qksmimo = d
End Function

Private Function fenjieyinzi(sa As String) As String
Dim A, B
Dim x As String
x = sa
B1 = Sqr(Val(x)) / 2
If InStr(B1, ".") = 0 Then
B = B1
Else
B = Left(B1, InStr(B1, ".") - 1)
End If
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
b2 = x / I
If InStr(b2, ".") = 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

Private Function fenjieyinzi0(n As String) As String
If Len(n) < 11 Then
fenjieyinzi0 = fenjieyinzi(Trim(n))
Else
Dim A
n = Trim(n)
n1 = MPC(Trim(n), 1)
A = 123
'a为明文
a1 = zzxc(Trim(n), Trim(A))
If Val(a1) > 1 Then
fenjieyinzi0 = a1 & "*"
Else
c = 999
'c为公约
Do While zzxc(Trim(n1), Trim(c)) > 1
c = Val(c - 1)
Loop
d = qniyuan(Trim(c), Trim(n1))
'd为逆元为私钥
a2 = qksmimo(Trim(A), Trim(c), Trim(n))
'a2为密文
a3 = qksmimo(Trim(a2), Trim(d), Trim(n))
If MBJC(Trim(a3), Trim(A)) = 0 Then
fenjieyinzi0 = "这是素数有" & Len(n) & "位"
Else
fenjieyinzi0 = "2*2"
End If
End If


End If
End Function




Private Sub Command1_Click()
Dim A, B
A = Val(Text1)
a1 = A
q = Val(Text2)
m = Sqr(q)
t = Trim(Text4)
ts = Timer
If Right(A, 1) Mod 2 = 0 Then
A = A + 1
Else
A = A
End If
s = 0
a2 = A
Do While a2 <= m
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0
a2 = a2 + 2
Loop
B1 = a2
b2 = MPC(Trim(t), Trim(B1))

C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Trim(b2))

If InStr(C1, "*") = 0 And InStr(C2, "*") = 0 Then
s = s + 1
Print B1, b2
Text3 = Text3 & "/" & B1 & "/" & b2 & vbCrLf
Else
s = s
End If
a2 = a2 + 2

Loop
a2 = a2
s1 = s
Do While a2 + 2 <= q
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0
a2 = a2 + 2
Loop
B1 = a2
b2 = MPC(Trim(t), Trim(B1))

C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Trim(b2))

If InStr(C1, "*") = 0 And InStr(C2, "*") = 0 Then
s1 = s1 + 1
Print B1, b2
Text3 = Text3 & "/" & B1 & "/" & b2 & vbCrLf
Else
s1 = s1
End If
a2 = a2 + 2

Loop
Combo1 = a1 & "与" & q & "之间打头的素数有" & s1 & "组偶数" & t & "的哥猜素数和对:（用时" & Timer - ts & "秒）" & vbCrLf & Text3

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Combo1 = ""
Form1.Cls
End Sub

ysr 发表于 2021-4-8 17:41

30000与60000之间打头的素数有60组偶数13916000003349999997294的哥猜素数和对:（用时949.7266秒）
/31181/13916000003349999966113
/31307/13916000003349999965987
/31397/13916000003349999965897
/32117/13916000003349999965177
/32303/13916000003349999964991
/32783/13916000003349999964511
/33317/13916000003349999963977
/33647/13916000003349999963647
/33773/13916000003349999963521
/34457/13916000003349999962837
/35603/13916000003349999961691
/35933/13916000003349999961361
/36017/13916000003349999961277
/36107/13916000003349999961187
/36467/13916000003349999960827
/36527/13916000003349999960767
/37313/13916000003349999959981
/37607/13916000003349999959687
/37781/13916000003349999959513
/37811/13916000003349999959483
/38447/13916000003349999958847
/38603/13916000003349999958691
/38747/13916000003349999958547
/41213/13916000003349999956081
/41627/13916000003349999955667
/41687/13916000003349999955607
/41801/13916000003349999955493
/41843/13916000003349999955451
/42101/13916000003349999955193
/42197/13916000003349999955097
/43403/13916000003349999953891
/43913/13916000003349999953381
/44621/13916000003349999952673
/45077/13916000003349999952217
/46091/13916000003349999951203
/46901/13916000003349999950393
/47303/13916000003349999949991
/47441/13916000003349999949853
/47657/13916000003349999949637
/47717/13916000003349999949577
/49481/13916000003349999947813
/49547/13916000003349999947747
/49667/13916000003349999947627
/50087/13916000003349999947207
/50093/13916000003349999947201
/50753/13916000003349999946541
/50951/13916000003349999946343
/51581/13916000003349999945713
/51767/13916000003349999945527
/51941/13916000003349999945353
/52727/13916000003349999944567
/53117/13916000003349999944177
/55541/13916000003349999941753
/55697/13916000003349999941597
/55871/13916000003349999941423
/56957/13916000003349999940337
/58061/13916000003349999939233
/59183/13916000003349999938111
/59273/13916000003349999938021
/59453/13916000003349999937841
（看来更稀了，就是在60000内的素数打头，有该偶数的88+60=148组哥德巴赫猜想的拆分素数和对）

查看完整版本: [原创]大整数的乘法