Triangle Packing

Author

Eric W. Weisstein
February 14, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/TrianglePacking.nb.

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

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

Code

ColoredPolygon[l_List,color_]:={{color,Polygon[l]},Line[Append[l,l[[1]]]]}
OutlinedPolygon[l_List,color_]:={{RGBColor[1,1,.7],Polygon[l]},Line[Append[l,l[[1]]]]}

Triangle[{x_,y_},a_,color_:0]:={
OutlinedPolygon[{{x,y},{x+Abs[a],y},{x+Abs[a]/2,y+ a Sqrt[3]/2}},If[color==0,Hue[Random[]],color]],
Text[ToString[Abs[a]],{x+Abs[a]/2,y+ a/2/Sqrt[2]}]
}

triangle[{x_,y_},a_,color_:0]:={
OutlinedPolygon[{{x,y},{x+Abs[a],y},{x+Abs[a]/2,y+ a Sqrt[3]/2}},If[color==0,Hue[Random[]],color]],
Text[ToString[Abs[a]],{x+Abs[a]/2,y+ a/2/Sqrt[2]}],
Text[FullSimplify[#],#]&/@{{x,y},{x+ Abs[a],y},{x+Abs[a]/2,y+a Sqrt[3]/2}}
}

Triangles in Circles

Show[GraphicsArray[Partition[
Graphics[#,AspectRatio->Automatic,PlotRange->All]&/@Table[Packing[{n,Triangle},Circle],{n,6}],
3]
]]

Triangles in Squares

Show[GraphicsArray[Partition[
Graphics[#,AspectRatio->Automatic,PlotRange->All]&/@Table[Packing[{n,Triangle},Square],{n,6}],
3]
]]

Triangles in Triangles

Show[GraphicsArray[Partition[
Graphics[#,AspectRatio->Automatic,PlotRange->All]&/@Table[Packing[{n,Triangle},Triangle],{n,6}],
3]
]]

1-7 Triangles

Show[Graphics[{
Triangle[{-6,0},1],

Triangle[{-4,0},1],
Triangle[{3/2-5,Sqrt[3]/2},-1],

Triangle[{4-5,0},1],
Triangle[{7/2-5,Sqrt[3]/2},-1],
Triangle[{9/2-5,Sqrt[3]/2},-1],

Triangle[{4-2,0},1],
Triangle[{7/2-2,Sqrt[3]/2},-1],
Triangle[{9/2-2,Sqrt[3]/2},-1],
Triangle[{7/2-2,Sqrt[3]/2},2],

Triangle[{1+4,0},1],
Triangle[{1+7/2,Sqrt[3]/2},-1],
Triangle[{1+9/2,Sqrt[3]/2},-1],
Triangle[{1+7/2,Sqrt[3]/2},2],
Triangle[{1+9/2,3Sqrt[3]/2},-2],

Triangle[{1+3+4,0},1],
Triangle[{1+3+7/2,Sqrt[3]/2},-1],
Triangle[{1+3+9/2,Sqrt[3]/2},-1],
Triangle[{1+3+7/2,Sqrt[3]/2},2],
Triangle[{1+3+9/2,3Sqrt[3]/2},-2],
Triangle[{1+8,0},3],

Triangle[{13,0},2],
Triangle[{12,Sqrt[3]},-2],
Triangle[{12,Sqrt[3]},1],
Triangle[{12+1/2,Sqrt[3]3/2},-1],
Triangle[{13,Sqrt[3]},1],
Triangle[{13+1/2,Sqrt[3]3/2},-3],
Triangle[{12+1/2,Sqrt[3]3/2},4],

Text["1",{-5.5,-1}],
Text["2",{-3.5,-1}],
Text["3",{-.5,-1}],
Text["7",{2.5,-1}],
Text["11",{5.5,-1}],
Text["20",{9.5,-1}],
Text["36",{14,-1}]

},AspectRatio->Automatic,PlotRange->All]]

8-11 Triangles

Show[Graphics[{
Triangle[{0,0},3],
Triangle[{3/2,Sqrt[3]3/2},-3],
Triangle[{3/2,Sqrt[3]3/2},3],
Triangle[{-2,2Sqrt[3]},-4],
Triangle[{-2,2Sqrt[3]},4],
Triangle[{0,4Sqrt[3]},-2],
Triangle[{1,3Sqrt[3]},-2],
Triangle[{1,3Sqrt[3]},2],

Triangle[{5,2Sqrt[3]},-4],
Triangle[{7,0},4],
Triangle[{9,2Sqrt[3]},-1],
Triangle[{19/2,3Sqrt[3]/2},-3],
Triangle[{11,0},3],
Triangle[{25/2,3Sqrt[3]/2},-3],
Triangle[{5,2Sqrt[3]},5],
Triangle[{15/2,9Sqrt[3]/2},-5],
Triangle[{19/2,3Sqrt[3]/2},6],

Triangle[{19-7/2,7/2Sqrt[3]},-7],
Triangle[{19-7/2,7/2Sqrt[3]},8],
Triangle[{39/2,15Sqrt[3]/2},-4],
Triangle[{43/2,11Sqrt[3]/2},4],
Triangle[{43/2,11Sqrt[3]/2},-4],
Triangle[{19,0},6],
Triangle[{22,3Sqrt[3]},-6],
Triangle[{22,3Sqrt[3]},1],
Triangle[{22+1/2,3Sqrt[3]+Sqrt[3]/2},-1],
Triangle[{23,3Sqrt[3]},5],

Triangle[{35,0},11],
Triangle[{35-9/2,9Sqrt[3]/2},-9],
Triangle[{35-9/2,9Sqrt[3]/2},7],
Triangle[{34,8Sqrt[3]},-7],
Triangle[{75/2,9Sqrt[3]/2},2],
Triangle[{77/2,11Sqrt[3]/2},5],
Triangle[{41,8Sqrt[3]},-5],
Triangle[{77/2,11Sqrt[3]/2},-2],
Triangle[{81/2,11Sqrt[3]/2},-3],
Triangle[{84/2,8Sqrt[3]/2},8],
Triangle[{84/2,8Sqrt[3]/2},-8],

Text["71",{1.5,-1.5}],
Text["146",{10.5,-1.5}],
Text["260",{22,-1.5}],
Text["496",{40.5,-1.5}]

},AspectRatio->Automatic,PlotRange->All]]

15 Triangles

{Length[#],Tr[#^2]}&[{4,4,15,31,27,23,23,16,16,17,17,19,1,18,1}]

Show[Graphics[{
Triangle[{0,0},4],
Triangle[{2,4Sqrt[3]/2},-4],
Triangle[{-9+15/2,2Sqrt[3]+15Sqrt[3]/2},-15],
Triangle[{-25,2Sqrt[3]},31],
Triangle[{-25,2Sqrt[3]},-27],
Triangle[{-23/2,-23Sqrt[3]/2},23],
Triangle[{0,0},-23],
Triangle[{-19/2,35Sqrt[3]/2},-16],
Triangle[{-3/2,19Sqrt[3]/2},16],
Triangle[{13/2,35Sqrt[3]/2},-17],
Triangle[{47/2-17/2,19Sqrt[3]/2-1},17],
Triangle[{4,0},19],
Triangle[{27/2,19Sqrt[3]/2},-1],
Triangle[{14,-1+19Sqrt[3]/2},-18],
Triangle[{14,-1+19Sqrt[3]/2},1],
Style[Text["15 triangles, area == 4,782",{2,-25}],FontSize->14,FontSlant->"Italic"]
},AspectRatio->Automatic,PlotRange->All]]

17 Triangles

{Length[#],Tr[#^2]}&[{4,1,51,47,47,27,27,27,16,5,11,11,5,6,6,50,44}]

Show[Graphics[{
Triangle[{0,0},-4],
Triangle[{4,0},-1],
Triangle[{4-51/2,-51 Sqrt[3]/2},51],
Triangle[{-45,-2Sqrt[3]},-47],
Triangle[{-45,-2Sqrt[3]},47],
Triangle[{-43/2,43Sqrt[3]/2},-27],
Triangle[{-8,8Sqrt[3]},27],
Triangle[{11/2,43Sqrt[3]/2},-27],
Triangle[{-8,8Sqrt[3]},-16],
Triangle[{0,0},5],
Triangle[{5/2,5Sqrt[3]/2},11],
Triangle[{8,8Sqrt[3]},-11],
Triangle[{5/2,5Sqrt[3]/2},-5],
Triangle[{5+5/2,5Sqrt[3]/2},-6],
Triangle[{2+5/2,-Sqrt[3]/2},6],
Triangle[{2+5/2,-Sqrt[3]/2},-50],
Triangle[{109/2-44,-Sqrt[3]/2},44],
Style[Text["17 triangles, area == 14,279",{2,-50}],FontSize->14,FontSlant->"Italic"]
},AspectRatio->Automatic,PlotRange->All]]