无聊之中，做了一个质数判断，尚待完善

aoe1981

liucqa 发表于 2014-1-19 12:36
http://wenku.baidu.com/link?url=uvVSbDfA3G54TrJRwjV0L7VMOqneH6-xlBk2eW4adApcD-w3ChxFs01BOkmc_nL2Fnf8 ...

整理一下，以下代码可概括为：2、3、5、7、11、13＋划2、3、5序列！

按这篇百度文库文章的指导思想做了下修改，是否确实起到了优化的效果，由于目前15位数以上的问题没有最终解决，故而难以发现其是否具有运行效率上的优势。代码如下：

Private Sub CommandButton1_Click()
Dim i&, n#, j#, pdjg$, d As Object, ys(), cs(), rng As Range, rng1 As Range, k&, m%  '判断结果、因数、次数
If TextBox1.Text = "" Then MsgBox "请输入要判断的自然数！", , "友情提示": Label3.Caption = "": Exit Sub
If IsNumeric(TextBox1.Text) = False Then MsgBox "请输入数字，中间不能有空格！", , "友情提示": TextBox1.Text = "": Label3.Caption = "": Exit Sub
If TextBox1.Text <> Int(TextBox1.Text) Then MsgBox "请输入整数！", , "友情提示":  TextBox1.Text = "": Label3.Caption = "": Exit Sub
If TextBox1.Text < 2 Then MsgBox "请输入大于1的自然数！", , "友情提示":  TextBox1.Text = "": Label3.Caption = "": Exit Sub
If TextBox1.Text > 999999999999999# Then MsgBox "数据过大，本程序最大可判断的15位数！", , "友情提示": TextBox1.Text = "": Label3.Caption = "": Exit Sub
n = TextBox1.Text
Set d = CreateObject("Scripting.Dictionary")
Do
    If n = 2 Then Exit Do
    i = 2
    Do Until i > n / i
        j = n / i
        If j = Int(j) Then d(i) = d(i) + 1: GoTo 100
        Select Case i
        Case Is >= 13
            If m Mod 8 = 0 Then m = 0: k = k + 1
            Select Case m Mod 8
            Case 0
                i = 30 * k - 13
            Case 1
                i = 30 * k - 11
            Case 2
                i = 30 * k - 7
            Case 3
                i = 30 * k - 1
            Case 4
                i = 30 * k + 1
            Case 5
                i = 30 * k + 7
            Case 6
                i = 30 * k + 11
            Case 7
                i = 30 * k + 13
            End Select
            m = m + 1
        Case 2
            i = 3
        Case 3
            i = 5
        Case 5
            i = 7
        Case 7
            i = 11
        Case 11
            i = 13
        End Select
    Loop
    Exit Do
100:
    n = j
Loop
If d.Count <> 0 Then d(n) = d(n) + 1
ys() = d.keys
cs() = d.items
For i = 0 To UBound(ys)
If cs(i) > 1 Then pdjg = pdjg & ys(i) & "^" & cs(i) & "*" Else pdjg = pdjg & ys(i) & "*"
Next i
If pdjg = "" Then Label3.Caption = "素数" Else Label3.Caption = "合数 " & Left(pdjg, Len(pdjg) - 1)
'以下代码往工作表中记录判断结果
If [g1] = "" Then Set rng = [g1] Else Set rng = Cells(Rows.Count, "g").End(xlUp).Offset(1, 0)
If Cells(1, 256) = "" Then Set rng1 = Cells(1, 256) Else Set rng1 = Cells(Rows.Count, 256).End(xlUp).Offset(1, 0)
If Columns(256).Find(TextBox1.Text, , , xlWhole) Is Nothing Then
    If Label3.Caption <> "素数" Then
        rng.Value = TextBox1.Text & "＝" & Left(pdjg, Len(pdjg) - 1)
    Else
        rng.Value = TextBox1.Text & "是素数"
    End If
    rng1.Value = TextBox1.Text
End If
End Sub

附注：在大数据下（15位以上）进行运算时，首先需特殊处理的为蓝色的两处除法运算，红色处如果大数据在30位以上时，则有可能产生超过15位以上的因数（i）参与判断，这时，将有11处外调程序，相信这样的“优化”反而得不偿失。。。将数据限制在30位及以内还是可行的（其实判断还是进行到输入数据开平方根大小的时候即停止的，30位开平方根的大小差不多是15位），不过也得看实际的运行时间是个什么状况，本次优化，个人感觉“五五开”！不过依据百度文库文章的介绍，只划掉2、3的倍数剩下的数是2、3、6*k±1，这倒只有两种情况，比2、3、5、7、9、11、13、15、17........先偶后奇的序列既简洁又少了不少数据，减少了许多次循环，而且代码也会简单，一会再传。。。
　　其中循环的处理如下图示：

新的附件如下：
素数判断（参照优化版2）.rar (17.56 KB, 下载次数: 30)

2014-1-19 16:43 上传

点击文件名下载附件

aoe1981

liucqa 发表于 2014-1-19 12:42
//找出n以内质数
void Sieve(int n)
        {

这个是什么代码？不懂的。。。

aoe1981

liucqa 发表于 2014-1-19 12:36
http://wenku.baidu.com/link?url=uvVSbDfA3G54TrJRwjV0L7VMOqneH6-xlBk2eW4adApcD-w3ChxFs01BOkmc_nL2Fnf8 ...

整理一下，以下代码可概括为：2、3＋划2、3序列！

以下是只划掉2、3倍数后剩余序列循环的代码，该序列为：2、3、6*k±1。
Private Sub CommandButton1_Click()
Dim i&, n#, j#, pdjg$, d As Object, ys(), cs(), rng As Range, rng1 As Range, k&, m%  '判断结果、因数、次数
If TextBox1.Text = "" Then MsgBox "请输入要判断的自然数！", , "友情提示": Label3.Caption = "": Exit Sub
If IsNumeric(TextBox1.Text) = False Then MsgBox "请输入数字，中间不能有空格！", , "友情提示": TextBox1.Text = "": Label3.Caption = "": Exit Sub
If TextBox1.Text <> Int(TextBox1.Text) Then MsgBox "请输入整数！", , "友情提示":  TextBox1.Text = "": Label3.Caption = "": Exit Sub
If TextBox1.Text < 2 Then MsgBox "请输入大于1的自然数！", , "友情提示":  TextBox1.Text = "": Label3.Caption = "": Exit Sub
If TextBox1.Text > 999999999999999# Then MsgBox "数据过大，本程序最大可判断的15位数！", , "友情提示": TextBox1.Text = "": Label3.Caption = "": Exit Sub
n = TextBox1.Text
Set d = CreateObject("Scripting.Dictionary")
Do
    If n = 2 Then Exit Do
    i = 2
    Do Until i > n / i
        j = n / i
        If j = Int(j) Then d(i) = d(i) + 1: GoTo 100
        Select Case i
        Case Is >= 3
            If m Mod 2 = 0 Then m = 0: k = k + 1
            Select Case m Mod 2
            Case 0
                i = 6 * k - 1
            Case 1
                i = 6 * k + 1
            End Select
            m = m + 1
        Case 2
            i = 3
        End Select
    Loop
    Exit Do
100:
    n = j
Loop
If d.Count <> 0 Then d(n) = d(n) + 1
ys() = d.keys
cs() = d.items
For i = 0 To UBound(ys)
If cs(i) > 1 Then pdjg = pdjg & ys(i) & "^" & cs(i) & "*" Else pdjg = pdjg & ys(i) & "*"
Next i
If pdjg = "" Then Label3.Caption = "素数" Else Label3.Caption = "合数 " & Left(pdjg, Len(pdjg) - 1)
'以下代码往工作表中记录判断结果
If [g1] = "" Then Set rng = [g1] Else Set rng = Cells(Rows.Count, "g").End(xlUp).Offset(1, 0)
If Cells(1, 256) = "" Then Set rng1 = Cells(1, 256) Else Set rng1 = Cells(Rows.Count, 256).End(xlUp).Offset(1, 0)
If Columns(256).Find(TextBox1.Text, , , xlWhole) Is Nothing Then
    If Label3.Caption <> "素数" Then
        rng.Value = TextBox1.Text & "＝" & Left(pdjg, Len(pdjg) - 1)
    Else
        rng.Value = TextBox1.Text & "是素数"
    End If
    rng1.Value = TextBox1.Text
End If
End Sub
着色部分为大数据情况下应当注意的运算，蓝色为必须重视，红色为30位及以内数据可以忽略的部分。。。

aoe1981

excelvlookup 发表于 2014-1-18 23:00
此题的难点在于N过大时运算速度，其他的都不是问题

目前的问题是大数据如何实现！Excel中超过15位时便自动舍入成近似的科学计数法了。。。不知，可有高见！

aoe1981

liucqa 发表于 2014-1-19 12:43
http://zh.wikipedia.org/wiki/AKS%E8%B3%AA%E6%95%B8%E6%B8%AC%E8%A9%A6

至于此文，高深莫测，莫测高深！留给真正数学与计算机的大家们去钻研吧，区区此生无望。。。鄙只想能测试到30位就不错了。。。如何突破15位以上自动舍入科学计数法的限制，虽有研究线索，但仍需高人指教一二。。。求助了。。。

liucqa

aoe1981 发表于 2014-1-19 17:43
目前的问题是大数据如何实现！Excel中超过15位时便自动舍入成近似的科学计数法了。。。不知，可有高见！

vb中的大数四则运算，你可以去问lee1892

C#的可以看这个
http://club.excelhome.net/thread-1076623-1-1.html

pt98

'找了个c代码稍作修改，10000000之内耗时0.7s
Option Explicit
Const N  As Long = 10000000
Private Sub Command1_Click()
    Dim i As Long, j As Long, flag() As Boolean, arr() As Long, c As Long, t
    ReDim flag(N), arr(N)
    t = Timer
    For i = 2 To Sqr(N)
        If flag(i) = False Then
            For j = 2 * i To N Step i
                flag(j) = True
            Next
        End If
    Next
    For i = 2 To N
        If flag(i) = False Then
            arr(c) = i
            c = c + 1
        End If
    Next
    ReDim Preserve arr(c - 1)
    MsgBox "用时：" & Timer - t & vbNewLine & "个数：" & c
End Sub

aoe1981

liucqa 发表于 2014-1-19 19:50
vb中的大数四则运算，你可以去问lee1892

C#的可以看这个

级别尚低，只能发个消息，看其发表的主题，就可以感知其是数学与计算机的大家。。。君知此人，可见亦是不俗！

northwolves

如果只是为了得到一个结果，可利用网络资源，如：

1.     Function Numberfactorizer(ByVal number As String) As String
   
2.     Dim v() As String, i As Long
   
3.     If number Like "*[!0-9]*" Then Exit Function '非数字
   
4.     If Len(number) > 49 Then Exit Function '大于10^50
   
5.     With CreateObject("Microsoft.XmlHttp")
   
6.     .Open "get", "http://www.numberempire.com/numberfactorizer.php?number=" & number, False
   
7.     .send
   
8.     v = Split(Replace(Split(Split(.responsetext, "Factorization: ")(1), "</td>")(0), ">", "<"), "<")
   
9.     End With
   
10.     For i = 1 To UBound(v) Step 2
    
11.     v(i) = ""
    
12.     Next
    
13.    
    
14.     Numberfactorizer = number & "=" & Join(v, "")
    
15.       
    
16.     End Function
    
17.     Sub test()
    
18.     Debug.Print Numberfactorizer("5496798436872018423594784658472398479365743653459")
    
19.     End Sub

复制代码

返回：5496798436872018423594784658472398479365743653459=13*103*315021047821*463054894236413*28142144229712042097

northwolves

更多资源，可参考：http://en.wikipedia.org/wiki/Prime_factorization