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

grf1973

第39题：整数边长直角三角形

若三边长{a,b,c}均为整数的直角三角形周长为p，当p = 120时，恰好存在三个不同的解：

{20,48,52}, {24,45,51}, {30,40,50}

在所有的p ≤ 1000中，p取何值时有解的数目最多？

香川群子

可以直接使用我上次的数学原理吧。

香川群子

周长 p = 840 时，最多有8组整数，可以构成直角三角形。
40  399  401
56  390  394
105  360  375
120  350  370
140  336  364
168  315  357
210  280  350
240  252  348

1. Sub test()
   
2.     For p = 3 To 1000
   
3.         n = 0
   
4.         a2 = Int(p / (2 + Sqr(2)))
   
5.         For c = Int(p * Sqr(2) / (2 + Sqr(2))) To p / 2
   
6.             ab = p * (p / 2 - c)
   
7.             For a = 1 To a2
   
8.                 b = ab / a
   
9.                 If b = Int(b) Then
   
10.                     If a + b + c = p Then n = n + 1
    
11.                 End If
    
12.             Next
    
13.         Next
    
14.         If n > r Then r = n: s = p
    
15.     Next
    
16.     Debug.Print r; s
    
17. End Sub

复制代码

grf1973

嗯，昨天试了一下。确实高效。

香川群子

grf1973 发表于 2017-11-10 16:40
嗯，昨天试了一下。确实高效。

我这个解法是独创的，前无古人吧。

因为无需直接计算、比较三条边的平方和，所以高效。

香川群子

修改了一下，还可以再快4-5倍！！！（因为是全部整数计算，避免了b=ab/a的小数计算）

1. Sub test2() 'by kagawa
   
2.     Dim a&, a2&, ab&, b&, c&, n&, r&, s&, p&, p2&, tms#
   
3.     tms = Timer
   
4.    
   
5.     For p = 3 To 1000 '循环遍历检查周长定值p
   
6.         n = 0 '计数n归零
   
7.         a2 = Int(p / (2 + Sqr(2))) '按等腰直角三角形计算a的最大值a2
   
8. 
   
9.         For c = p / 2 To Int(p * Sqr(2) / (2 + Sqr(2))) Step -1
   
10.             '循环遍历直角边c的范围：从半周长p/2 到 最小值等腰直角三角形时的c1
    
11. 
    
12.             ab = p * (p / 2 - c) '按数学原理推算、如果满足直角三角形平方和、且周长定值，则可得到ab值
    
13.             p2 = p - c '计算半周长(略微提高计算效率)
    
14.             For a = 1 To a2 '遍历最小边a的范围： 从1 到 最大值a2
    
15. 
    
16.                 b = p2 - a '直接求出b值 即：可满足周长定值的b
    
17.                 If a * b = ab Then '仅需验证ab乘积，即可满足直角三角形的平方和
    
18.                     n = n + 1  '满足条件时即可得到一组周长=定值p的直角三角形abc三边的整数解
    
19. '                    Debug.Print a; b; c '必要时输出结果
    
20.                     Exit For '可以直接退出速度更快一些些
    
21.                 End If
    
22.             Next
    
23.         Next
    
24.         If n > r Then r = n: s = p '记录遍历周长p时对应有解数n的最大值、及对应周长值p
    
25.     Next
    
26.     Debug.Print r; s; Format(Timer - tms, "0.000s") '输出结果和耗时
    
27. End Sub
    

复制代码

香川群子

这下应该是VBA代码中的世界第一快了，哈哈。

grf1973

VBA里应该是的吧。除非有更好的思路。
但VBA在数据处理方面实在够弱。
大师去看看146题呗，帮我优化优化。

pengyx

由方程组a^2+b^2=c^2,a+b+c=p,得到b的a、p表达式。循环P，3到1000，在P中循环a从1到Int(p / (2 + Sqr(2)))。判断b>0,b为整，不知是不是还高效一些，没试过

pengyx

这个我的电脑上0.109s
Sub aa()
Dim ar(1 To 100, 1 To 3)
x = 0: y = 0
ti = Timer
For p = 3 To 1000
    t = 0: s = Int(p / (2 + 2 ^ 0.5))
    For a = 1 To s
        b = (2 * p * a - p ^ 2) / (2 * (a - p))
        If b > 0 And b = Int(b) Then
            t = t + 1
            ar(t, 1) = a: ar(t, 2) = b: ar(t, 3) = p - a - b
        End If
    Next
    If t > x Then
        ReDim br(1 To t, 1 To 3)
        x = t: y = p
        For i = 1 To t
            br(i, 1) = ar(i, 1): br(i, 2) = ar(i, 2): br(i, 3) = ar(i, 3)
        Next
    End If
Next
MsgBox Timer - ti
Sheet1.Range("a1").Resize(x, 3) = br
Sheet1.Range("d1") = x
Sheet1.Range("e1") = y
End Sub