用VBA解欧拉计划题目（3）

grf1973

第3题 ：最大质因数

13195的所有质因数为5、7、13和29。

600851475143最大的质因数是多少？

1. Sub problem3()   '求600851475143的最大质因数（结果是6857）
   
2.     Dim n
   
3.     tm = Timer
   
4.     n = 600851475143#
   
5.     arr = GetPrimeArray(Int(Sqr(n)))   '生成质数数组
   
6.     For k = UBound(arr) To 2 Step -1  '从大往下循环，找到第一个
   
7.         If n / arr(k) = Int(n / arr(k)) Then Exit For
   
8.     Next
   
9.     res = arr(k)
   
10.     Debug.Print res, Timer - tm
    
11. End Sub
    
12. 
    
13. Function GetPrimeArray(n)     '得到小于n的质数数组  欧几里德筛选法  by GTR
    
14.     Dim p&
    
15.     ReDim a(1 To n) As Byte
    
16.     i = 2
    
17.     Do While i <= Sqr(n)   ' / 2
    
18. '        a(i) = 1
    
19. '        p = p + 1
    
20.         j = 2 * i
    
21.         Do While j <= n
    
22.             a(j) = 1      'a(j) + 1
    
23.             j = j + i
    
24.         Loop
    
25.         i = i + 1
    
26.         Do While a(i) = 1 And i < n
    
27.             i = i + 1
    
28.         Loop
    
29.     Loop
    
30. 
    
31.     ReDim b(1 To n) As Long
    
32.     For i = 2 To n
    
33.         If a(i) = 0 Then
    
34.             m = m + 1
    
35.             b(m) = i
    
36.         End If
    
37.     Next
    
38.     ReDim Preserve b(1 To m) As Long
    
39.     GetPrimeArray = b
    
40. End Function

复制代码

香川群子

你这程序结果错误。

600851475143/6857=876259 余数 6780

我觉得应该是分解为：1814713*43*11*7

grf1973

香川群子 发表于 2017-10-31 17:16
你这程序结果错误。

600851475143/6857=876259 余数 6780

立即窗口输入：
?600851475143/6857
87625999

我的结果是不会错的，因为我是注册做题的，每次提交正确后我才确认完成。

grf1973

?600851475143/1814713
331100.000464536

香川群子

grf1973 发表于 2017-10-31 19:21
立即窗口输入：
?600851475143/6857
87625999

哦。我错了，把原始数字输入=6008514743……少了2个数字。600851475143

应该是：
600,851,475,143= 6857*1471*839*71

香川群子

grf1973 发表于 2017-10-31 19:25
?600851475143/1814713
331100.000464536

我的代码比你的快5倍。

素数筛选算法，我自己优化过了，是目前VBA中速度最快的算法。

1. Sub test2()
   
2.     Dim ar, i&, n, s$
   
3.     n = 600851475143#
   
4.     ar = GetPrimeArr(Int(Sqr(n)))
   
5.     For i = UBound(ar) To 2 Step -1
   
6.         If n / ar(i) = Int(n / ar(i)) Then s = s & "*" & ar(i)
   
7.     Next
   
8.     Debug.Print n & " = " & Mid(s, 2)
   
9. End Sub
   
10. Function GetPrimeArr(n&) 'by kagawa
    
11.     Dim i&, j&, k&, m&
    
12.     m = Int((n - 1) / 2): ReDim a(1 To m) As Byte
    
13.     For i = 1 To Sqr(n) \ 2
    
14.         If a(i) = 0 Then
    
15.             For j = i * 3 + 1 To m Step i * 2 + 1
    
16.                 a(j) = 1
    
17.             Next
    
18.         End If
    
19.     Next
    
20.    
    
21.     ReDim b&(1 To m): b(1) = 1: b(2) = 2: k = 2
    
22.     For i = 1 To m
    
23.         If a(i) = 0 Then k = k + 1: b(k) = i * 2 + 1
    
24.     Next
    
25.     ReDim Preserve b&(1 To k)
    
26.     GetPrimeArr = b
    
27. End Function

复制代码

香川群子

计算结果：
600851475143 = 6857*1471*839*71

grf1973

嗯。终于找到一个快一点的筛选法了。原来那个是我儿子提供给我的。。。。。
不过你的21句要小改一下，毕竟1不是质数。

1. Function GetPrimeArr(n&) 'by kagawa
   
2.     Dim i&, j&, k&, m&
   
3.     m = Int((n - 1) / 2): ReDim a(1 To m) As Byte
   
4.     For i = 1 To Sqr(n) \ 2
   
5.         If a(i) = 0 Then
   
6.             For j = i * 3 + 1 To m Step i * 2 + 1
   
7.                 a(j) = 1
   
8.             Next
   
9.         End If
   
10.     Next
    
11.    
    
12.     ReDim b&(1 To m): b(1) = 2:  k = 1
    
13.     For i = 1 To m
    
14.         If a(i) = 0 Then k = k + 1: b(k) = i * 2 + 1
    
15.     Next
    
16.     ReDim Preserve b&(1 To k)
    
17.     GetPrimeArr = b
    
18. End Function

复制代码

上清宫主

不就是找最大质因数吗？没搞懂为什么要那么麻烦
以下代码也不比你们的慢：
Sub test()
n = 600851475143#
i = 2#
s = 0#
t = Timer
Do While i < n
   s = n / i
   If InStr(s, ".") < 1 Then
      n = n / i
      i = i - 1
    End If
   i=i+1
Loop
Debug.Print i, Timer - t
End Sub
另：好象你们提供的，对于本身就是素数的数就不大对了

grf1973

上清宫主 发表于 2017-11-1 11:20
不就是找最大质因数吗？没搞懂为什么要那么麻烦
以下代码也不比你们的慢：
Sub test()

是的，前期的题目的确不用考虑时间度，算法。但后面会慢慢出现超大数量级的类型，算法就尤为重要了。