整海伦三角形的个数问题

nyy

northwolves 发表于 2023-12-8 11:59
这样好理解，计算稍慢一点

1. (*整海伦三角形的个数问题 https://bbs.emath.ac.cn/thread-17135-1-1.html (出处: 数学研发论坛)*)
   
2. Clear["Global`*"];(*清除所有变量*)
   
3. (*子函数,海伦公式,利用海伦公式计算三角形的面积*)
   
4. heron[a_,b_,c_]:=Module[{p=(a+b+c)/2},Sqrt[p*(p-a)*(p-b)*(p-c)]]
   
5. (*最大边的长度*)
   
6. max=100;
   
7. (*形成三边(三边关系a<=b<=c)以及面积(不考虑是否为虚数)*)
   
8. aa=Flatten[#,2]&@Table[{a,b,c,heron[a,b,c]},{c,1,max},{b,1,c},{a,1,b}];
   
9. (*根据两短边之和大于最大边、三边长度互质、面积为整数过滤得到答案*)
   
10. bb=Select[aa,And[(#1+#2>#3)&@@#,GCD[#1,#2,#3]&@@#==1,IntegerQ[#4]&@@#]&]
    
11. (*计算list的维度*)
    
12. cc=Dimensions[bb]
    

复制代码

输出结果

1. {{3,4,5,6},{5,5,6,12},{5,5,8,12},{5,12,13,30},{10,13,13,60},{4,13,15,24},{13,14,15,84},{9,10,17,36},{8,15,17,60},{16,17,17,120},{11,13,20,66},{7,15,20,42},{10,17,21,84},{13,20,21,126},{13,13,24,60},{12,17,25,90},{7,24,25,84},{14,25,25,168},{3,25,26,36},{17,25,26,204},{17,25,28,210},{20,21,29,210},{6,25,29,60},{17,17,30,120},{11,25,30,132},{5,29,30,72},{8,29,35,84},{15,34,35,252},{25,29,36,360},{19,20,37,114},{15,26,37,156},{13,30,37,180},{12,35,37,210},{24,37,37,420},{16,25,39,120},{17,28,39,210},{25,34,39,420},{10,35,39,168},{29,29,40,420},{13,37,40,240},{25,39,40,468},{15,28,41,126},{9,40,41,180},{17,40,41,336},{18,41,41,360},{29,29,42,420},{15,37,44,264},{17,39,44,330},{13,40,45,252},{25,25,48,168},{29,35,48,504},{21,41,50,420},{39,41,50,780},{26,35,51,420},{20,37,51,306},{25,38,51,456},{13,40,51,156},{27,29,52,270},{25,33,52,330},{37,39,52,720},{15,41,52,234},{5,51,52,126},{25,51,52,624},{24,35,53,336},{28,45,53,630},{4,51,53,90},{51,52,53,1170},{26,51,55,660},{20,53,55,528},{25,39,56,420},{53,53,56,1260},{33,41,58,660},{41,51,58,1020},{17,55,60,462},{15,52,61,336},{11,60,61,330},{22,61,61,660},{25,52,63,630},{33,34,65,264},{20,51,65,408},{12,55,65,198},{33,56,65,924},{14,61,65,420},{36,61,65,1080},{16,63,65,504},{32,65,65,1008},{35,53,66,924},{65,65,66,1848},{21,61,68,630},{43,61,68,1290},{7,65,68,210},{29,65,68,936},{57,65,68,1710},{29,52,69,690},{37,37,70,420},{9,65,70,252},{41,50,73,984},{26,51,73,420},{35,52,73,840},{48,55,73,1320},{19,60,73,456},{50,69,73,1656},{25,51,74,300},{25,63,74,756},{35,44,75,462},{29,52,75,546},{32,53,75,720},{34,61,75,1020},{56,61,75,1680},{13,68,75,390},{52,73,75,1800},{40,51,77,924},{25,74,77,924},{68,75,77,2310},{41,41,80,360},{17,65,80,288},{9,73,80,216},{39,55,82,924},{35,65,82,1092},{33,58,85,660},{29,60,85,522},{39,62,85,1116},{41,66,85,1320},{36,77,85,1386},{13,84,85,546},{41,84,85,1680},{26,85,85,1092},{72,85,85,2772},{34,55,87,396},{52,61,87,1560},{38,65,87,1140},{44,65,87,1386},{31,68,87,930},{61,74,87,2220},{65,76,87,2394},{53,75,88,1980},{65,87,88,2640},{41,50,89,420},{28,65,89,546},{39,80,89,1560},{21,82,89,840},{57,82,89,2280},{78,89,89,3120},{53,53,90,1260},{17,89,90,756},{37,72,91,1260},{60,73,91,2184},{26,75,91,840},{22,85,91,924},{48,85,91,2016},{29,75,92,966},{39,85,92,1656},{34,65,93,744},{39,58,95,456},{41,60,95,798},{68,87,95,2850},{73,73,96,2640},{37,91,96,1680},{51,52,97,840},{65,72,97,2340},{26,73,97,420},{44,75,97,1584},{35,78,97,1260},{75,86,97,3096},{11,90,97,396},{78,95,97,3420},{51,53,100,714},{61,69,100,2070},{17,87,100,510},{21,89,100,840},{51,91,100,2310},{61,91,100,2730},{89,99,100,3960}}

复制代码

结果2
{173, 4} 一共173组情况

估计你少的情况

{{10,13,13,60},{16,17,17,120},{14,25,25,168},{24,37,37,420},{18,41,41,360},{22,61,61,660},{32,65,65,1008},{26,85,85,1092},{72,85,85,2772},{78,89,89,3120}}

northwolves

理论上直接计算比Select快些

1. max = 100; sol = {}; Do[p = (a + b + c)/2;
   
2. If[GCD[a, b, c] == 1, A2 = p (p - a) (p - b) (p - c); A = Sqrt[A2];
   
3.   If[IntegerQ[A], AppendTo[sol, {a, b, c, A}]]], {c, 5, max}, {b,
   
4.   c}, {a, c - b + 1, b}]; sol

复制代码