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

excelvlookup

此题的难点在于N过大时运算速度，其他的都不是问题

aoe1981

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

这不是问题，因为最大只能判断15位数，开个方，划掉10以内质数的倍数再循环，次数不多，速度很快，没想像得可怕，，，，想测试更大的，但无奈Excel vba中数字太大，超过15位时都近似成了科学计数法。。。唉。。

yjh_27

aoe1981 发表于 2014-1-18 23:48
这不是问题，因为最大只能判断15位数，开个方，划掉10以内质数的倍数再循环，次数不多，速度很快，没想像 ...

自定义函数，位数超长数字的加减乘除计算。

aoe1981

现在总算可以告一段落了，吸取别人的长处，保留自己的长处，强强结合!呵呵，这东西研究起来还真是费时费力。。。

Private Sub CommandButton1_Click()
Dim x&, i&, n#, j#, pdjg$, d As Object, ys(), cs(), scsr#, rng As Range '判断结果、因数、次数、上次输入

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
    If n ^ 0.5 = Int(n ^ 0.5) Then x = n ^ 0.5 Else x = Int(n ^ 0.5 + 1)
    For i = 2 To x
        If i <> 2 And i Mod 2 = 0 Then GoTo 100
        If i <> 3 And i Mod 3 = 0 Then GoTo 100
        If i <> 5 And i Mod 5 = 0 Then GoTo 100
        If i <> 7 And i Mod 7 = 0 Then GoTo 100
        j = n / i
        If j = Int(j) Then d(i) = d(i) + 1: GoTo 200
100:
    Next
    Exit Do
200:
    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 Label3.Caption <> "质数" Then
If [g1] = "" Then Set rng = [g1] Else Set rng = Cells(Rows.Count, "g").End(xlUp).Offset(1, 0)
If TextBox1.Text <> Cells(1, 256).Value Then rng.Value = TextBox1.Text & "＝" & Left(pdjg, Len(pdjg) - 1)
End If
Cells(1, 256).Value = TextBox1.Text
End Sub

现在，分解后最长的式子应当是数：912750790581630
本程序现在还具备了判断历史结果的记忆功能，而且是不重复的。。。

aoe1981

yjh_27 发表于 2014-1-19 00:12
自定义函数，位数超长数字的加减乘除计算。

好的，明天或其他时候一定慢慢研究下。。。。现在除了15位数的问题外，其他的算是圆满解决了，可以暂时休息下了。。。。。。。。。。多谢。。

aoe1981

这次再行上传一个优化版1，主要做了两点：
1、进一步参照优化了循环次数，现在按2、3、5、7、9、11、13.........直到输入数据的开平方根（进一法取整）为止，并且在其中划掉3、5、7的倍数，当然，也可以判断划掉11、13、17、19、23........等的倍数，以更多的减少循环次数，但是这样做没完没了，代码重复冗长；
2、真正实现了对历史判断结果的无重复记录，前次所谓无重复其实有点问题，传一张记录结果图，会感受到这样做带来便于复制粘贴结果的好处：

以下是优化后的代码：

Private Sub CommandButton1_Click()
Dim x&, i&, n#, j#, pdjg$, d As Object, ys(), cs(), rng As Range, rng1 As Range '判断结果、因数、次数
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
    If n ^ 0.5 = Int(n ^ 0.5) Then x = n ^ 0.5 Else x = Int(n ^ 0.5 + 1)
    For i = 1 To x Step 2
        If i = 1 Then i = 2
        If i <> 3 And i Mod 3 = 0 Then GoTo 100
        If i <> 5 And i Mod 5 = 0 Then GoTo 100
        If i <> 7 And i Mod 7 = 0 Then GoTo 100
        j = n / i
        If j = Int(j) Then d(i) = d(i) + 1: GoTo 200
100:
    If i = 2 Then i = 1
    Next
    Exit Do
200:
    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位数，稍后再行研究超过15位数的，如果可以忍受这个范围，目前还算完美吧。。。呵呵

质数判断（参照优化版1）.rar (16 KB, 下载次数: 12)

2014-1-19 10:23 上传

点击文件名下载附件

aoe1981

整理一下，以下代码可概括为：2＋划2序列，大数据下估计此代码最优！

为了给大数据运算做准备，又做了优化，主要是：取消了开方运算，核心部分只保留了两次除法和一次加法，这样如果调用大数据除、加运算会减少调用次数。。。。相比是取其利大于弊的。。。。但还不会调用那位高手的大数据运算代码的。。。有人指点就好了，太费时间了，焦灼哇。。。

Private Sub CommandButton1_Click()
Dim i&, n#, j#, pdjg$, d As Object, ys(), cs(), rng As Range, rng1 As Range '判断结果、因数、次数
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
        If i = 2 Then i = 3 Else i = i + 2
    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

liucqa

http://wenku.baidu.com/link?url= ... mPgmjVxdWqRZEWdpB5e

liucqa

//找出n以内质数
void Sieve(int n)
        {
            bool[] a = new bool[n+1];
            for (int i = 2; i <= n; i++)  a[i] = true;
            for (int i = 2; i <= Math.Sqrt(n); i++)
            {
                if (a[i])
                    for (int j = i; j*i <= n; j++) a[j * i] = false;
            }
            for (int i = 0; i <= n; i++)
            {
                if (a[i])
                    Console.Write("{0},",i.ToString());
            }
        }

liucqa

http://zh.wikipedia.org/wiki/AKS ... 8%E6%B8%AC%E8%A9%A6