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

grf1973

第14题：最长考拉兹序列

在正整数集上定义如下的迭代序列：

n → n/2 （若n为偶数）
n → 3n + 1 （若n为奇数）

从13开始应用上述规则，我们可以生成如下的序列：

13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1

可以看出这个序列（从13开始到1结束）共有10项。尽管还没有被证明，但我们普遍认为，从任何数开始最终都能迭代至1（“考拉兹猜想”）。

从小于一百万的哪个数开始，能够生成最长的序列呢？

注： 序列开始生成后允许其中的项超过一百万。

结果是：起始数： 837799 ，最长链数： 525     ，运算了 40秒。

grf1973

似乎除了逐条链尝试没有什么好的办法。
好在符合欧拉计划一分钟内出结果的要求。

1. Sub problem14()   'Collatz问题：按N→n/2（n为偶数），N→3n + 1（n为奇数），任意数最后可结束于1。求100万以下产生最长链的数。 结果：837799
   
2.     Dim N, k&, kmax&
   
3.     tm = Timer
   
4.     Nmax& = 1000000
   
5.     For i& = Nmax To 1 Step -1
   
6.         N = i: k = 0
   
7.         Do While N <> 1
   
8.             N = IIf(Int(N / 2) = N / 2, N / 2, 3 * N + 1)
   
9.             k = k + 1
   
10.         Loop
    
11.         If kmax < k Then kmax = k: p = i
    
12.     Next
    
13.     Debug.Print "起始数： " & p & " ，最长链数： " & kmax + 1, Timer - tm
    
14. End Sub

复制代码

香川群子

标记一下，凡是用过的数字都不需要再检查了。

这样应该会快一点。

香川群子

做到了秒杀。比你的代码快几十倍。

暂且不写注释了，有本事自己看懂。

1. Sub test2() 'by kagawa
   
2.     Dim a&(), b(), i&, j&, k&, k2&, m&, m2&, n, n2, r&, s&, t&, cnt&, tms#
   
3.     tms = Timer
   
4.    
   
5.     m = 10 ^ 6 '设置检查范围100万
   
6.     ReDim a&(m), b(1000)
   
7.     a(1) = 1
   
8.     For i = 2 To m
   
9.         n = i: b(0) = n: k = 0: t = 0
   
10.         Do
    
11.             n2 = n / 2: If n2 = Int(n2) Then n = n2 Else n = n * 3 + 1
    
12.             k = k + 1: b(k) = n
    
13.             If n < m Then t = a(n)
    
14.         Loop Until t
    
15.         
    
16.         k2 = k + t
    
17.         For j = 0 To k
    
18.             If b(j) < m Then a(b(j)) = k2 - j
    
19.         Next
    
20.         
    
21.         If k2 > r Then r = k2: s = i
    
22.         cnt = cnt + k
    
23.     Next
    
24.     Debug.Print vbCr; "检查总次数"; cnt
    
25.     Debug.Print "最长链数"; r; "起始数"; s; Format(Timer - tms, "0.000s")
    
26. End Sub

复制代码

香川群子

我的代码，仅需检查 3558013 次
用你的代码，检查次数=132434427

相差37倍。

grf1973

当然能看懂。事实上之前我自己还搞了个做标记的，但速度比不做标记还慢，就放弃了。结果倒是正确的。
原理和你的是一模一样的，差别只不过你用数组做标记，我用字典。充分说明了字典的无能与低效。

1. Sub problem14a()   'Collatz问题：按N→n/2（n为偶数），N→3n + 1（n为奇数），任意数最后可结束于1。求100万以下产生最长链的数。 结果：837799
   
2.     Dim n, k&, kmax&
   
3.     tm = Timer
   
4.     Nmax& = 1000000
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     Set d1 = CreateObject("scripting.dictionary")
   
7.     d(1) = 1
   
8.     For i& = 1 To Nmax
   
9.         If Not d.exists(i) Then
   
10.             n = i: k = 0
    
11.             d1.RemoveAll: d1(n) = ""
    
12.             Do While Not d.exists(n)
    
13.                 n2 = n / 2
    
14.                 n = IIf(Int(n2) = n2, n2, 3 * n + 1)
    
15.                 k = k + 1
    
16.                 d1(n) = ""
    
17.             Loop
    
18.             k = k + d(n)   '如果中间遇到已经判断过的数
    
19.             p = 0
    
20.             For Each x In d1.keys
    
21.                 d(x) = k - p
    
22.                 p = p + 1
    
23.             Next
    
24.             If kmax < k Then kmax = k: q = i
    
25.         End If
    
26.     Next
    
27.     Debug.Print "起始数： " & q & " ，最长链数： " & kmax + 1, Timer - tm
    
28. End Sub

复制代码

grf1973

上面的代码运行了900秒。。。。。，差点崩溃

today0427

grf1973 发表于 2017-11-3 16:17
上面的代码运行了900秒。。。。。，差点崩溃

别着急，科学高峰哪里是那么好登攀的，至少还有香川老师带着你，还有我们在地心流着口水仰望你们，你们俩先爬，我们随后踩着你们留下的坚实脚印上！

香川群子

grf1973 发表于 2017-11-3 16:16
当然能看懂。事实上之前我自己还搞了个做标记的，但速度比不做标记还慢，就放弃了。结果倒是正确的。
原理 ...

我一开始也是用字典，速度很快就慢下来了。

于是决定用数组……但数组碰到了严重的问题，这个问题不解决，就无法使用。

你既然看懂了代码，那么应该知道是什么问题，以及我的解决办法了吧。

grf1973

应该是不知道生成链条的过程中出现的最大值，用数组有可能溢出。然后你就做了个限制，忽略掉了大数。
对吧？