用vBA解欧拉计划题目（75）--唯一的整数边直角三角形

grf1973

唯一的整数边直角三角形

只能唯一地弯折成整数边直角三角形的电线最短长度是12厘米；当然，还有很多长度的电线都只能唯一地弯折成整数边直角三角形，例如：

12厘米: (3,4,5)
24厘米: (6,8,10)
30厘米: (5,12,13)
36厘米: (9,12,15)
40厘米: (8,15,17)
48厘米: (12,16,20)

相反地，有些长度的电线，比如20厘米，不可能弯折成任何整数边直角三角形，而另一些长度则有多个解；例如，120厘米的电线可以弯折成三个不同的整数边直角三角形。

120厘米: (30,40,50), (20,48,52), (24,45,51)

记电线长度为L，对于L ≤ 1,500,000，有多少种取值只能唯一地弯折成整数边直角三角形？

香川群子

这个直角三角形问题，之前已经讨论过了。

不过，计算量超大的话，是否还有更好的剪枝方法？

目前这个代码理论上可行，但是150万的范围，运算估计耗时要几个小时？

1. Sub test()
   
2.     Dim a&, b#, k&, m&, r#, s&, s2&, cnt&, tms#
   
3.     tms = Timer
   
4.    
   
5.     m = 1.5 * 10 ^ 6
   
6.     m = 1000
   
7.     r = 1 / (1 + Sqr(2) / 2)
   
8.     For s = 1 To m / 2
   
9.         s2 = s * 2
   
10.         k = 0
    
11.         For a = 1 To Int(s * r)
    
12.             b = (s - a) / (1 - a / s2)
    
13.             If b = Int(b) Then If k Then k = 2: Exit For Else k = 1
    
14.         Next
    
15.         If k = 1 Then cnt = cnt + 1
    
16.     Next
    
17.     Debug.Print Format(Timer - tms, "0.000s"); cnt
    
18. End Sub

复制代码

香川群子

按此代码，预计要计算2-3个小时。
检查2到1万，仅需0.3秒，但是检查149万到150万，耗时就达到75秒。
因为周长数越大，整数的组合可能就越多……需要的检查量呈指数上升。

grf1973

这题需要一点数学知识。

1. '记电线长度为L，对于L ≤ 1,500,000，有多少种取值只能唯一地弯折成整数边直角三角形？
   
2. '原理：（欧几里德公式）  记a=m^2-n^2,b=2mn,c=m^2+n^2，则a,b,c满足勾股
   
3. '原理：m,n奇偶性不同，且m,n互质，产生本原的abc勾股数，据此可以得到所有ka,kb,kc的勾股数
   
4. Sub problem75()   '结果是161667，运行18秒
   
5.     tm = Timer
   
6.     maxl = 1500000
   
7.     maxm = Int(Sqr(maxl / 2))
   
8.     Dim m#, n#
   
9.     Set d = CreateObject("scripting.dictionary")
   
10.     For m = 2 To maxm
    
11.         For n = 1 To m - 1
    
12.             If (m + n) Mod 2 = 1 Then
    
13.                 'If 最大公约数(m, n) = 1 Then
    
14.                 If GCD(m, n) = 1 Then
    
15.                     a = m * m - n * n
    
16.                     b = 2 * m * n
    
17.                     c = m * m + n * n
    
18.                     l = a + b + c
    
19.                     Do While l <= maxl
    
20.                         d(l) = d(l) + 1
    
21.                         l = l + a + b + c
    
22.                     Loop
    
23.                 End If
    
24.             End If
    
25.         Next
    
26.     Next
    
27.     For Each l In d.keys
    
28.         If d(l) = 1 Then res = res + 1
    
29.     Next
    
30.     Debug.Print res, "共运行" & Timer - tm & "秒"
    
31. End Sub

复制代码

香川群子

哦，原来如此。

那就只需0.3秒，比你快 60倍！

1. Sub test2() 'by kagawa 检查指定长度区间内，构成唯一直角三角形3条整数边的周长个数
   
2.     Dim d&(), k&, l&, m&, m1&, m2&, n&, s&, tms#
   
3.     tms = Timer
   
4.    
   
5.     m = 1500000 '检查周长范围: 1-150万
   
6.     m1 = m / 2 '需检查的周长为偶数，范围只占一半
   
7.     m2 = Int(Sqr(m1)) '按开方数范围检查即可
   
8.    
   
9.     ReDim d&(1 To m1) '用数组记录解个数 远比字典快
   
10.     For m = 1 To m2 '遍历m
    
11.         For n = IIf(m Mod 2, 2, 1) To m - 1 Step 2 '保证m,n的奇偶互异性
    
12.             If GCD(m, n) = 1 Then '检查保证m,n互质
    
13.                 s = (m + n) * m '直接计算半周长s=a+b+c=
    
14.                 For l = s To m1 Step s '在半周长范围内按步长s标记
    
15.                     d(l) = d(l) + 1
    
16.                 Next
    
17.             End If
    
18.         Next
    
19.     Next
    
20.    
    
21.     For l = 1 To m1
    
22.         If d(l) = 1 Then k = k + 1 '检查统计满足只有1个解的周长个数
    
23.     Next
    
24.     Debug.Print Format(Timer - tms, "0.000s"); k
    
25. End Sub
    
26. Function GCD&(t1&, t2&) '最大公约数 G.C.D=Greatest Common Divisor
    
27.     If t1 Mod t2 Then GCD = GCD(t2, t1 Mod t2) Else GCD = t2
    
28. End Function
    

复制代码

grf1973

嗯，第11句最佳，减少一半循环量。

grf1973

比较了一下，其他优化速度差异不大，但一旦把字典改成数组了，马上提高几十倍。