Heronian Triangle

Author

Eric W. Weisstein
August 23, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/DiophantineEquations/HeronianTriangle.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/HeronianTriangle.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Code

HeronianArea::usage="HeronianArea[{a,b,c}] returns the area of the triangle with side lengths {a,b,c}.";

HeronianTriangleQ::usage="HeronianTriangleQ[{a,b,c}] returns True if {a,b,c} is a Heronian triangle.";
HeronianTriangleQ[{a0_,b0_,c0_}]:=Module[{a,b,c,s},
{a,b,c}=Sort[{a0,b0,c0}];
s=(a+b+c)/2;
(a+b≠c)&&IntegerQ[HeronianArea[{a,b,c}]]]

HeronianArea[{a_,b_,c_}]:=Module[{s=(a+b+c)/2},Sqrt[s(s-a)(s-b)(s-c)]]

Parametric

Buchholtz

Simplify[With[{a=n(m^2+k^2),b=m(n^2+k^2),c=(m+n)(m n-k^2)},
{s=(a+b+c)/2,Sqrt[s(s-a)(s-b)(s-c)]}
],k>0&&m>0&&n>0]

With[{max=10},
l=Select[Flatten[Table[{k,m,n},{k,0,max},{m,max},{n,max}],2],GCD@@#==1&&Function[{k,m,n},m n>k^2>m^2n/(2m+n)]@@#&&#[[2]]≥#[[3]]≥1&]
]

heronian=Sort[Reverse/@Function[{k,m,n},{n(m^2+k^2),m(n^2+k^2),(m+n)(m n-k^2)}]@@@l]

And@@IntegerQ/@HeronianArea/@heronian

Search

With[{n=50},(heronian=Select[Flatten[Table[{i,j,k},{i,n},{j,i,n},{k,j,n}],2],HeronianTriangleQ])
]//Timing

And@@IntegerQ/@HeronianArea/@heronian

Figure

Take[Sort[heronian,OrderedQ[Reverse/@{#1,#2}]&],4]

With[{dx=.5},
Show[GraphicsArray[Graphics[{
t=Triangle@@#,
Text[#[[1]],{-dx,#[[1]]/2}],
Text[#[[2]],{#[[2]]/2,-dx}],
Text[#[[3]],{dx+#[[2]],dx+#[[1]]}/2],
{Red,
Text[HeronianArea[#],Coordinates[Incenter[Triangle[{{0,0},{0,#[[1]]},{#[[2]],0}}]]]]
}
},PlotRange->All]&/@Take[Sort[heronian,OrderedQ[Reverse/@{#1,#2}]&],4]
]]
]

Scalene

max=50;
Sort[Select[Flatten[Table[{i,j,k},{i,max},{j,i+1,max},{k,j+1,max}],2],HeronianTriangleQ],OrderedQ[Reverse/@{#1,#2}]&]

All

max=50;
Sort[Select[Flatten[Table[{i,j,k},{i,max},{j,i,max},{k,j,max}],2],HeronianTriangleQ],OrderedQ[Reverse/@{#1,#2}]&]

HeronianArea/@%

Right and Isosceles Triangles Sharing Area and Perimeter

Developer`SetSystemOptions["ReduceOptions"->{"DiscreteSolutionBound"->1000}];

ap[{{a_,b_,c_},{x_,y_}}]:={{a b/2,x Sqrt[y^2-x^2/4]/2},{a+b+c,x+2y}}

n=500

With[{max=500},
Length[trips500=Select[Map[Last,List@@(Reduce[x^2+y^2==z^2&&0<x<y<max&&0<z<max,{x,y,z},Integers,Backsubstitution->True]/.And:>List),{2}],GCD@@Most[#]==1&]]
]//Timing

Timing[solns=Select[{#,
Last/@(Reduce[Plus@@#==2y+x&&Times@@Most[#]==x Sqrt[y^2-x^2/4]&&0<x<2y,{x,y},Integers,Backsubstitution->True]/.And:>List)
}&/@trips500,
Last[#]=!=False&]]

LabeledTriangle[a_List,opts___?OptionQ]:=Module[{t=Triangle@@a,off=Offset/.{opts}/.{Offset->{0,0}}},
{
t/.Triangle[x_]:>Triangle[off+#&/@x],
Text[#1,#2+off,Background->White]&@@@Transpose[{SideLengths[Evaluate[t]],Coordinates/@Midpoint/@Sides[t]}]
}
]

With[{x=20},
Show[Graphics[{
LabeledTriangle[{135,352,377}],
Line[{{x,0},{x,x},{0,x}}],
LabeledTriangle[{132,366,366},Offset->{200,0}]
}
],AspectRatio->Automatic,PlotRange->All]
]

n=1000

With[{max=1000},
Length[trips1000=Select[Map[Last,List@@(Reduce[x^2+y^2==z^2&&0<x<y<max&&0<z<max,{x,y,z},Integers,Backsubstitution->True]/.And:>List),{2}],GCD@@Most[#]==1&]]
]//Timing

Timing[solns=Select[{#,
Last/@(Reduce[Plus@@#==2y+x&&Times@@Most[#]==x Sqrt[y^2-x^2/4]&&0<x<2y,{x,y},Integers,Backsubstitution->True]/.And:>List)
}&/@trips1000,
Last[#]=!=False&]]

ap/@solns

n=2000

Developer`SetSystemOptions["ReduceOptions"->{"DiscreteSolutionBound"->10000}];

With[{max=2000},
Length[trips2000=Select[Map[Last,List@@(Reduce[x^2+y^2==z^2&&0<x<y<max&&0<z<max,{x,y,z},Integers,Backsubstitution->True]/.And:>List),{2}],GCD@@Most[#]==1&]]
]//Timing

Timing[solns=Select[{#,
Last/@(Reduce[Plus@@#==2y+x&&Times@@Most[#]==x Sqrt[y^2-x^2/4]&&0<x<2y,{x,y},Integers,Backsubstitution->True]/.And:>List)
}&/@trips2000,
Last[#]=!=False&]]

ap/@solns

n=5000

Developer`SetSystemOptions["ReduceOptions"->{"DiscreteSolutionBound"->10000}];

With[{max=5000},
Length[trips5000=Select[Map[Last,List@@(Reduce[x^2+y^2==z^2&&0<x<y<max&&0<z<max,{x,y,z},Integers,Backsubstitution->True]/.And:>List),{2}],GCD@@Most[#]==1&]]
]//Timing

Timing[solns=Select[{#,
Last/@(Reduce[Plus@@#==2y+x&&Times@@Most[#]==x Sqrt[y^2-x^2/4]&&0<x<2y,{x,y},Integers,Backsubstitution->True]/.And:>List)
}&/@trips5000,
Last[#]=!=False&]]

ap/@solns