一款可瞬间判定素数的神奇小软件

数学爱好者A

做加法的时候就带进位一起做就完了嘛！

moranhuishou

下面引用由数学爱好者A在 2008/09/24 04:07am 发表的内容：
Private Sub Command1_Click()
   Dim aa(100000)  As  integer      ';存放被加数的各位数字
   Dim bb(100000)  As  integer     ';存放加数的各位数字
   Dim cc(100000)  As  integer      ';存 ...

谢谢数A先生：
不过运行有点问题——
高亮显示：
无效的过程调用或参数
bb(i) = Val(Mid(b, Lb - 4 * i + 1, 4))
请修改。

moranhuishou

[这个贴子最后由moranhuishou在 2008/09/29 10:02pm 第 1 次编辑]

不知道该怎么处理，请朋友们帮忙：
下面的程序代码运行正常，可判定素数。 只要将
a = c / x
换成大数运算即可。
因为不是一次性而是循环运算，不知道怎样连接。

Private Sub Command1_Click()
dim...
...  
for i=1 to n   
......
   
Print c
a = c / x
Next i
  Text2.Text = a
End Sub
把大数除法程序贴上，就是不循环。除法程序单独运行没有问题。

Bardo

一秒钟可以判定近千个十位数.但数字大了,速度肯定会慢些,
一秒钟可以判定近千个十位数.这个速度不是很快。
楼主判定的方法可否经过严密的数学证明？
其实，判断是否为素数，目前的所有程序，均与时间复杂度有关，也就是数字的大小有关。所以，不要太乐观，真正测试了才会明白。
我有VB6的高精度计算类，是用字符串处理的，也是一个数组单元放一个10进制的位，所以，效率不高。但是，速度快的也有，就是其中开放所用的不是平方二项式开方，而是铺地锦模式。
但用它进行素数生成试除：即你那个输出 2 is prime 的程序一秒钟也可以判定近千个十位数。
所以，我难以相信，大数的速度真是那么快。
其二，现在确有很多快速判断素数的方法，但并不能判断所有的数。
所以，我认为，经过严密的数学证明的，那才是确实可信的。

Bardo

Option Explicit
Public Const MaxLenth = 20000
Dim Pom0(MaxLenth) As Long
Dim Pom1(MaxLenth) As Long
Dim Pom2(MaxLenth) As Long
Dim Pom3(MaxLenth) As Long
Dim Pom4(MaxLenth) As Long
Dim Pom5(MaxLenth) As Long
Dim Pom6(MaxLenth) As Long
Dim Pom7(MaxLenth) As Long
Dim LengthPom0 As Long
Dim LengthPom1 As Long
Dim LengthPom2 As Long
Dim LengthPom3 As Long
Dim LengthPom4 As Long
Dim LengthPom5 As Long
Dim LengthPom6 As Long
Dim LengthPom7 As Long
Dim K1(MaxLenth) As Long
Dim K10(MaxLenth) As Long
Dim K100(MaxLenth) As Long
Dim K200(MaxLenth) As Long
Dim K10000(MaxLenth) As Long
Dim A(MaxLenth) As Long
Dim B(MaxLenth) As Long
Dim C(MaxLenth) As Long
Dim D(MaxLenth) As Long
Dim LengthA As Long
Dim LengthB As Long
Dim LengthC As Long
Dim LengthD As Long
Function CompareB(A() As Long, LengthA As Long, B() As Long, LengthB As Long) As Long
Dim I As Long
Select Case LengthA - LengthB
Case Is < 0
    CompareB = -1
Case Is = 0
    CompareB = 0
    For I = 1 To LengthA
        Select Case A(LengthA - I + 1) - B(LengthA - I + 1)
        Case Is < 0
            CompareB = -1
            Exit For
        Case Is = 0
        Case Is > 0
            CompareB = 1
            Exit For
        End Select
    Next I
Case Is > 0
    CompareB = 1
End Select
End Function
Function BigNumberToText(C() As Long, Length As Long) As String
Dim I As Long
Dim Pom As String
If C(0) = -1 Then
    Pom = "-"
Else
    Pom = ""
End If
Pom = Pom & Format&#36;(C(Length), "0")
For I = Length - 1 To 1 Step -1
    Pom = Pom & Format&#36;(C(I), "0000")
Next I
BigNumberToText = Pom
End Function
Sub TextToBigNumber(Tekst As String, A() As Long, LengthA As Long)
Dim I As Long
Dim Prvi As String
Dim MaxLenthPrvi As Long
Dim Ostatak As Long
Prvi = Trim&#36;(Tekst)
If IsItBigNumber(Prvi) Then
    A(0) = 0
    If Left&#36;(Prvi, 1) = "+" Then
        Prvi = Right&#36;(Prvi, Len(Prvi) - 1)
    End If
    If Left&#36;(Prvi, 1) = "-" Then
        Prvi = Right&#36;(Prvi, Len(Prvi) - 1)
        A(0) = -1
    End If
   
    MaxLenthPrvi = Len(Prvi)
    If (MaxLenthPrvi \ 4) * 4 = MaxLenthPrvi Then
        LengthA = MaxLenthPrvi \ 4
        For I = 1 To LengthA
            A(I) = Mid&#36;(Prvi, MaxLenthPrvi - I * 4 + 1, 4)
        Next I
    Else
        LengthA = MaxLenthPrvi \ 4 + 1
        Ostatak = MaxLenthPrvi Mod 4
        For I = 1 To LengthA - 1
            A(I) = Mid&#36;(Prvi, MaxLenthPrvi - I * 4 + 1, 4)
        Next I
        A(LengthA) = Mid&#36;(Prvi, 1, Ostatak)
    End If
Else
    A(1) = 0
    LengthA = 1
End If
End Sub
Sub MinusB(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long)
Select Case CompareB(A, LengthA, B, LengthB)
Case Is < 0
    Call MinusBV(B, LengthB, A, LengthA, C, LengthC)
    C(0) = -1
Case Is = 0
    C(1) = 0
    LengthC = 1
    C(0) = 0
Case Is > 0
    Call MinusBV(A, LengthA, B, LengthB, C, LengthC)
    C(0) = 0
End Select
End Sub

Function IsItBigNumber(Ulaz As String) As Boolean
Dim Pom As String
Dim Pom1 As String
Dim I As Long
Dim IsItBigNumber1 As Boolean
Pom1 = Ulaz
Pom = Left&#36;(Pom1, 300)
If IsNumeric(Pom) Then
    If InStr(1, Pom, "e", 1) > 0 Then
        IsItBigNumber1 = False
    Else
        If InStr(1, Pom, ".", 1) > 0 Then
            IsItBigNumber1 = False
        Else
           If InStr(1, Pom, ",", 1) > 0 Then
               IsItBigNumber1 = False
           Else
               IsItBigNumber1 = True
           End If
        End If
    End If
Else
    IsItBigNumber1 = False
End If
If IsItBigNumber1 Then
    For I = 1 To Len(Pom1) \ 300
        Pom = Mid&#36;(Pom1, 300 * I, 300)
        If IsNumeric(Pom) Then
            If InStr(1, Pom, "e", 1) > 0 Then
                IsItBigNumber1 = False
            Else
                If InStr(1, Pom, ".", 1) > 0 Then
                    IsItBigNumber1 = False
                Else
                    If InStr(1, Pom, ",", 1) > 0 Then
                        IsItBigNumber1 = False
                    Else
                        If InStr(1, Pom, "-", 1) > 0 Then
                            IsItBigNumber1 = False
                        Else
                            If InStr(1, Pom, "+", 1) > 0 Then
                                IsItBigNumber1 = False
                            Else
                                IsItBigNumber1 = True
                            End If
                        End If
                    End If
                End If
            End If
        Else
            IsItBigNumber1 = False
        End If
        
    Next I
End If
IsItBigNumber = IsItBigNumber1
End Function
Sub AddBSigned(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long)
If A(0) = 0 And B(0) = 0 Then
    Call AddB(A, LengthA, B, LengthB, C, LengthC)
End If
If A(0) < 0 And B(0) < 0 Then
    Call AddB(A, LengthA, B, LengthB, C, LengthC)
    C(0) = -1
End If
If A(0) = 0 And B(0) < 0 Then
    Call MinusB(A, LengthA, B, LengthB, C, LengthC)
End If
If A(0) < 0 And B(0) = 0 Then
    Call MinusB(B, LengthB, A, LengthA, C, LengthC)
End If
End Sub
Sub MinusBSigned(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long)
If A(0) = 0 And B(0) = 0 Then
    Call MinusB(A, LengthA, B, LengthB, C, LengthC)
End If
If A(0) < 0 And B(0) < 0 Then
    Call MinusB(B, LengthB, A, LengthA, C, LengthC)
End If
If A(0) = 0 And B(0) < 0 Then
    Call AddB(A, LengthA, B, LengthB, C, LengthC)
    C(0) = 0
   
End If
If A(0) < 0 And B(0) = 0 Then
    Call AddB(B, LengthB, A, LengthA, C, LengthC)
    C(0) = -1
End If
End Sub
Sub MultBSigned(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long)
Call MultB(A, LengthA, B, LengthB, C, LengthC)
If (A(0) = 0 And B(0) = 0) Or (A(0) < 0 And B(0) < 0) Then
    C(0) = 0
Else
    If LengthC = 1 And C(1) = 0 Then
        C(0) = 0
    Else
        C(0) = -1
    End If
End If
End Sub
Sub CopyB(A() As Long, LengthA As Long, B() As Long, LengthB As Long)
Dim I As Long
LengthB = LengthA
For I = 0 To LengthA
    B(I) = A(I)
Next I
End Sub

Sub DivBSigned(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long, D() As Long, LengthD As Long)
Call DivB(A, LengthA, B, LengthB, C, LengthC, D, LengthD)
If (A(0) = 0 And B(0) = 0) Or (A(0) < 0 And B(0) < 0) Then
    C(0) = 0
Else
    If LengthC = 1 And C(1) = 0 Then
        C(0) = 0
    Else
        C(0) = -1
    End If
End If
End Sub
Sub DivB(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long, D() As Long, LengthD As Long)
If LengthB = 1 And B(1) = 0 Then
    C(1) = 0
    LengthC = 1
    C(0) = 0
    Exit Sub
End If
If LengthB = 1 And B(1) = 1 Then
    Call CopyB(A, LengthA, C, LengthC)
    Exit Sub
End If
If LengthA = 1 And A(1) = 0 Then
    C(1) = 0
    LengthC = 1
    C(0) = 0
    Exit Sub
End If
Select Case CompareB(A, LengthA, B, LengthB)
Case Is < 0
    C(1) = 0
    LengthC = 1
    C(0) = 0
Case Is = 0
    C(1) = 1
    LengthC = 1
    C(0) = 0
Case Is > 0
    Call DivBInt(A, LengthA, B, LengthB, C, LengthC, D, LengthD)
End Select
End Sub
Sub DivBInt(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long, D() As Long, LengthD As Long)
Dim I As Long
Dim J As Long
Dim StrA As String
Dim StrB As String
Dim StrC As String
Dim MaxLenthStrA As Long
Dim MaxLenthStrB As Long
Dim TR As String
K10(1) = 10
StrA = BigNumberToText(A, LengthA)
If Left&#36;(StrA, 1) = "-" Then StrA = Right&#36;(StrA, Len(StrA) - 1)
StrB = BigNumberToText(B, LengthB)
If Left&#36;(StrA, 1) = "-" Then StrA = Right&#36;(StrA, Len(StrA) - 1)
MaxLenthStrA = Len(StrA)
MaxLenthStrB = Len(StrB)
J = 0
Call TextToBigNumber(Left&#36;(StrA, MaxLenthStrB), Pom2, LengthPom2)
Do While CompareB(Pom2, LengthPom2, B, LengthB) >= 0
    J = J + 1
    Call MinusBV(Pom2, LengthPom2, B, LengthB, Pom3, LengthPom3)
    Call CopyB(Pom3, LengthPom3, Pom2, LengthPom2)
Loop
StrC = Format&#36;(J, "0")
For I = 1 To MaxLenthStrA - MaxLenthStrB
    J = 0
    Call MultB(Pom2, LengthPom2, K10, 1, Pom1, LengthPom1)
    Call TextToBigNumber(Mid&#36;(StrA, MaxLenthStrB + I, 1), Pom2, LengthPom2)
    TR = BigNumberToText(Pom1, LengthPom1)
    TR = BigNumberToText(Pom2, LengthPom2)
   
    Call AddB(Pom1, LengthPom1, Pom2, LengthPom2, Pom3, LengthPom3)
    Call CopyB(Pom3, LengthPom3, Pom2, LengthPom2)
    Do While CompareB(Pom2, LengthPom2, B, LengthB) >= 0
        J = J + 1
        Call MinusBV(Pom2, LengthPom2, B, LengthB, Pom3, LengthPom3)
        Call CopyB(Pom3, LengthPom3, Pom2, LengthPom2)
    Loop
    StrC = StrC & Format&#36;(J, "0")
Next I
Call CopyB(Pom2, LengthPom2, D, LengthD)
Call TextToBigNumber(StrC, C, LengthC)

End Sub
Sub AddB(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long)
Dim Prenos As Long
Dim I As Long
Dim J As Long
Prenos = 0
If LengthA > LengthB Then
    LengthC = LengthA + 1
    For I = 1 To LengthB
        C(I) = A(I) + B(I) + Prenos
        Prenos = C(I) \ 10000
        C(I) = C(I) Mod 10000
    Next I
    I = LengthB + 1
    Do While Prenos > 0 And I <= LengthA
        C(I) = A(I) + Prenos
        Prenos = C(I) \ 10000
        C(I) = C(I) Mod 10000
        I = I + 1
    Loop
    If I > LengthA Then
        C(I) = Prenos
    Else
        For J = I To LengthA
            C(J) = A(J)
        Next J
        C(LengthA + 1) = 0
    End If
Else
    LengthC = LengthB + 1
    For I = 1 To LengthA
        C(I) = A(I) + B(I) + Prenos
        Prenos = C(I) \ 10000
        C(I) = C(I) Mod 10000
    Next I
    I = LengthA + 1
    Do While Prenos > 0 And I <= LengthB
        C(I) = B(I) + Prenos
        Prenos = C(I) \ 10000
        C(I) = C(I) Mod 10000
        I = I + 1
    Loop
    If I > LengthB Then
        C(I) = Prenos
    Else
        For J = I To LengthB
            C(J) = B(J)
        Next J
        C(LengthB + 1) = 0
    End If
End If
If C(LengthC) = 0 Then LengthC = LengthC - 1
End Sub
Sub MinusBV(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long)
Dim Prenos As Long
Dim I As Long
Dim J As Long
Prenos = 0
LengthC = LengthA
For I = 1 To LengthB
    C(I) = A(I) - B(I) - Prenos
    If C(I) < 0 Then
        C(I) = C(I) + 10000
        Prenos = 1
    Else
        Prenos = 0
    End If
Next I
I = LengthB + 1
Do While Prenos > 0 And I <= LengthA
    C(I) = A(I) - Prenos
    If C(I) < 0 Then
        C(I) = C(I) + 10000
        Prenos = 1
    Else
        Prenos = 0
    End If
    I = I + 1
Loop
If I > LengthA Then
    C(I) = Prenos
Else
    For J = I To LengthA
        C(J) = A(J)
    Next J
End If
Do Until C(LengthC) <> 0 Or LengthC = 1
    LengthC = LengthC - 1
Loop
End Sub

Sub PowerB(A() As Long, LengthA As Long, PowerB As Long, C() As Long, LengthC As Long)
Dim I As Long
C(1) = 1
LengthC = 1
For I = 1 To PowerB
        Call MultBSigned(A, LengthA, C, LengthC, C, LengthC)
Next I
End Sub

Sub MultB(A() As Long, LengthA As Long, B() As Long, LengthB As Long, C() As Long, LengthC As Long)
Dim Prenos As Long
Dim I As Long
Dim J As Long
If (LengthB = 1 And B(1) = 0) Or (LengthA = 1 And A(1) = 0) Then
    C(1) = 0
    LengthC = 1
    C(0) = 0
    Exit Sub
End If
If LengthB = 1 And B(1) = 1 Then
    Call CopyB(A, LengthA, C, LengthC)
    Exit Sub
End If
If LengthA = 1 And A(1) = 1 Then
    Call CopyB(B, LengthB, C, LengthC)
    Exit Sub
End If
Prenos = 0
For I = 1 To LengthA + LengthB
    Pom0(I) = 0
Next I
For I = 1 To LengthB
    For J = 1 To LengthA
        Pom0(I + J - 1) = Pom0(I + J - 1) + A(J) * B(I)
        Prenos = Pom0(I + J - 1) \ 10000
        Pom0(I + J - 1) = Pom0(I + J - 1) Mod 10000
        Pom0(I + J) = Pom0(I + J) + Prenos
    Next J
Next I
LengthPom0 = LengthA + LengthB
Do Until Pom0(LengthPom0) <> 0 Or LengthPom0 = 1
    LengthPom0 = LengthPom0 - 1
Loop
Call CopyB(Pom0, LengthPom0, C, LengthC)
End Sub
Sub Factorial(Ulaz As Long, C() As Long, LengthC As Long)
Dim I As Long
C(1) = 1
LengthC = 1
For I = 2 To Ulaz
    Pom4(1) = I
    LengthPom4 = 1
    Call MultB(C, LengthC, Pom4, LengthPom4, C, LengthC)
Next I

End Sub
Sub SqrtB(A() As Long, LengthA As Long, C() As Long, LengthC As Long, D() As Long, LengthD As Long)
Dim Prvi As Long
Dim I As Long
Dim J As Long
Dim TR As String
For I = 0 To MaxLenth
    Pom4(I) = 0
    Pom5(I) = 0
    Pom6(I) = 0
    Pom7(I) = 0
    D(I) = 0
Next I
LengthPom4 = 1
LengthPom5 = 1
LengthPom6 = 1
LengthPom7 = 1
LengthD = 1
K100(1) = 100
K200(1) = 200
K10000(2) = 1
K1(1) = 1
If A(0) = 0 Then
    Prvi = Int(Sqr(A(LengthA)))
    C(1) = Prvi
    C(0) = 0
    LengthC = 1
    D(1) = A(LengthA) - Prvi * Prvi
    LengthD = 1
    For I = LengthA - 1 To 1 Step -1
        Call MultB(D, LengthD, K10000, 2, D, LengthD)
        D(1) = A(I)
        TR = BigNumberToText(D, LengthD)
        Call MultB(C, LengthC, K200, 1, Pom4, LengthPom4)
        TR = BigNumberToText(Pom4, LengthPom4)
        Call DivB(D, LengthD, Pom4, LengthPom4, Pom5, LengthPom5, Pom7, LengthPom7)
        TR = BigNumberToText(Pom5, LengthPom5)
        Call AddB(Pom5, LengthPom5, Pom4, LengthPom4, Pom4, LengthPom4)
        TR = BigNumberToText(Pom4, LengthPom4)
        Call MultB(Pom5, LengthPom5, Pom4, LengthPom4, Pom6, LengthPom6)
        TR = BigNumberToText(Pom6, LengthPom6)
        Do While CompareB(D, LengthD, Pom6, LengthPom6) < 0 And Pom5(1) > 0
            Call MinusB(Pom4, LengthPom4, K1, 1, Pom4, LengthPom4)
            TR = BigNumberToText(Pom4, LengthPom4)
            Call MinusB(Pom5, LengthPom5, K1, 1, Pom5, LengthPom5)
            TR = BigNumberToText(Pom5, LengthPom5)
            Call MultB(Pom5, LengthPom5, Pom4, LengthPom4, Pom6, LengthPom6)
            TR = BigNumberToText(Pom6, LengthPom6)
        Loop
        Call MinusB(D, LengthD, Pom6, LengthPom6, D, LengthD)
        TR = BigNumberToText(D, LengthD)
        Call MultB(C, LengthC, K100, 1, C, LengthC)
        TR = BigNumberToText(C, LengthC)
        Call AddB(C, LengthC, Pom5, LengthPom5, C, LengthC)
        TR = BigNumberToText(C, LengthC)
    Next I
Else
    C(1) = 0
    C(0) = 0
    LengthC = 1
End If
End Sub
Function BigAddition(ByVal aString As String, ByVal bString As String) As String
Call TextToBigNumber(aString, A, LengthA)
Call TextToBigNumber(bString, B, LengthB)
Call AddBSigned(A, LengthA, B, LengthB, C, LengthC)
BigAddition = BigNumberToText(C, LengthC)
End Function
Function BigSubtration(ByVal aString As String, ByVal bString As String) As String
Call TextToBigNumber(aString, A, LengthA)
Call TextToBigNumber(bString, B, LengthB)
Call MinusBSigned(A, LengthA, B, LengthB, C, LengthC)
BigSubtration = BigNumberToText(C, LengthC)
End Function
Function BigMultiplication(ByVal aString As String, ByVal bString As String) As String
Call TextToBigNumber(aString, A, LengthA)
Call TextToBigNumber(bString, B, LengthB)
Call MultBSigned(A, LengthA, B, LengthB, C, LengthC)
BigMultiplication = BigNumberToText(C, LengthC)
End Function
Function BigPower(ByVal aString As String, ByVal bString As String) As String
Call TextToBigNumber(aString, A, LengthA)
If IsItBigNumber(bString) Then
    If Abs(Val(bString)) <= 32767 Then
        Call PowerB(A, LengthA, Val(bString), C, LengthC)
        BigPower = BigNumberToText(C, LengthC)
    End If
Else
    BigPower = "0"
End If
End Function
Function BigDivisionMod(ByVal aString As String, ByVal bString As String, aMod As Boolean) As String
    Call TextToBigNumber(aString, A, LengthA)
    Call TextToBigNumber(bString, B, LengthB)
    Call DivBSigned(A, LengthA, B, LengthB, C, LengthC, D, LengthD)
    If aMod Then
        BigDivisionMod = BigNumberToText(D, LengthD)
    Else
        BigDivisionMod = BigNumberToText(C, LengthC)
    End If
End Function

我想了一下，楼主一定不清楚什么叫类，所以，四则运算类还是免了。
现给楼主的是网上另一网码写好的超大整数运算函数集。
你只要调用BIG打头的函数即可。

Bardo

上面定义是2000位。位数不够你可以再加。
另外告诉楼主：
现在计算程序一般用C++与汇编实现，乘法是用FFT变换，最大公约数是用Stein算法。
目前，网上有很多超大整数的C++源码。
最快的，所说，1000位的一万次开方，才0.1秒。

moranhuishou

谢谢：
确实不懂，仅仅为了这个编程思想才自学了一点点，就会简单的if then 循环语句。因为当时够用了，所以浅尝辄止，
所以你说的“BIG打头的函数”也不知道怎样调用，能举个例子说明吗？
关于速度，我在windows上的计算器上试过，300位的手工不到一个小时，所以我说会较快，程序速度怎样当然要最后测试。
我想，既然人们可以找到1000多万位的梅森素数，也同样可以找到那么大的一般素数，关键是一个“平台”。

天山草

下面引用由moranhuishou在 2008/09/29 11:29pm 发表的内容：
  ……关于速度，我在windows上的计算器上试过，300位的手工不到一个小时，所以我说会较快，……

     如果楼主肯公开你的方法，别人就容易帮你了。

moranhuishou

下面引用由天山草在 2008/09/29 11:54pm 发表的内容：
     如果楼主肯公开你的方法，别人就容易帮你了。

真的很抱歉，所以暂时不愿意公开，是因为——
1、如果没有价值（不是太快），则贻笑大方。
2、如果真的很快很有价值，公开了就都都会了，也就等于都不会，还是没有意义。
重要的是数学界没有人对真正有价值的成果鉴定承认，这是中国的悲哀！

天山草

楼主：
大数判素问题：在速度方面，您可以与美国的 Mathematica 软件进行比较；
国内的软件，可以与郭先强的大数计算器软件 HugeCalc 的速度进行比较。
不过，即使你的速度较慢，也不一定说明你的方法不行，因为速度还与编程有关。