Circle Packing

Author

Eric W. Weisstein
April 27, 2011

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

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

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

Circles in Circles

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

Circles in Squares

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

Circles in Triangles

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

Circle Triplets

a=Root[x^6+378*x^5+3411*x^4-8964*x^3-10233*x^2+3402*x-27,5];
b=Root[169*x^6+24978*x^5+2307*x^4-14580*x^3+3375*x^2+162*x-27,5];
c=Root[x^6+438*x^5+19077*x^4-15840*x^3-360*x^2+2592*x-432,4];

$TextStyle={FontFamily->"Times",FontSlant->"Italic",FontSize->12};

circ3[c_List,r_,str_String]:={Circle[#,r],Text[str,#]}&/@Table[{{Cos[ang],Sin[ang]},{-Sin[ang],Cos[ang]}}.c,{ang,0,4Pi/3,2Pi/3}]

Show[Graphics[{
Circle[{0,0},1],
{RGBColor[1,0,0],circ3[{0,2a/Sqrt[3]},a,"A"]},
{Purple,circ3[{Sqrt[3]/2(1-b),(1-b)/2},b,"B"]},
{RGBColor[0,0,1],circ3[{c #,Sqrt[2a c+a^2]+2a/Sqrt[3]},c,"C"]&/@{-1,1}}
}],AspectRatio->Automatic]

Packing in a Square

CircleV[1]:={{1/2,1/2}}
CircleR[1]:=1/2

CircleV[2]:={{1 - 1/Sqrt[2], 1 - 1/Sqrt[2]}, {1/Sqrt[2], 1/Sqrt[2]}}
CircleR[2]:=1/(2+Sqrt[2])

CircleV[3]:={{2/(4 + Sqrt[2] + Sqrt[6]), 2/(4 + Sqrt[2] + Sqrt[6])},
 {1 - (2*(1 + Sqrt[2]))/(4 + Sqrt[2] + Sqrt[6]), 1 - 2/(4 + Sqrt[2] + Sqrt[6])},
 {1 - 2/(4 + Sqrt[2] + Sqrt[6]), 1 - (2*(1 + Sqrt[2]))/(4 + Sqrt[2] + Sqrt[6])}}
CircleR[3]:=2/(4 + Sqrt[2] + Sqrt[6])

CircleV[4]:={{1/4, 1/4}, {1/4, 3/4}, {3/4, 1/4}, {3/4, 3/4}}
CircleR[4]:=1/4

CircleV[5]:=Append[Flatten[Table[(Sqrt[2]-1)/2{1,1}+(2-Sqrt[2]){i,j},{i,0,1},{j,0,1}],1],{1/2,1/2}]
CircleR[5]:=(Sqrt[2]-1)/2

CircleR[6]:=1/23*(-13 + 6*Sqrt[13])
CircleR[7]:=2/13*(4 - Sqrt[3])
CircleR[8]:=2/(2+Sqrt[2]+Sqrt[6])
CircleR[9]:=1/3
CircleR[10]:=0.296408

<<partition`

Show[GraphicsArray[partition[Table[
Graphics[{
{{RGBColor[0,1,0],Disk[#,CircleR[n]]},Circle[#,CircleR[n]]}&/@CircleV[n] ,
Line[{{0,0},{1,0},{1,1},{0,1},{0,0}}]
},AspectRatio->Automatic],
{n,5}
],3]
]]

Table[2CircleR[n],{n,5}]

N[%]

FullSimplify[2/(4+Sqrt[3])]

Identity[((2(4-(Sqrt[3])))/(Expand[(4+(Sqrt[3]))(4-(Sqrt[3]))]))]

N[%]

2/(2+Sqrt[2]+Sqrt[6])

N[%]

3 Circles

a={r,r};
b={r,r}+2r{Cos[#],Sin[#]}&[75Degree];
c={r,r}+2r{Cos[#],Sin[#]}&[15Degree];

2/(4 + Sqrt[2] + Sqrt[6])

FullSimplify[{a,b,c} /. r->(2/(4+(Sqrt[2])+(Sqrt[6])))]

Show[Graphics[{
{{RGBColor[0,1,0],Disk[#,r]},Circle[#,r]}&/@{a,b,c} ,
Line[{{0,0},{c[[1]]+r,0},{c[[1]]+r,b[[2]]+r},{0,b[[2]]+r},{0,0}}]
}/. r->(2/(4+(Sqrt[2])+(Sqrt[6]))),AspectRatio->Automatic]]

FullSimplify[Solve[b[[2]]+r==1,r]]

2N[(2/(4+(Sqrt[2])+(Sqrt[6])))]

Simplify[Sqrt[#.#]&[a-b]]

Planar Packing

Show[
Graphics[{
Table[Circle[{i,j},1/2],{i,7},{j,5}],
Table[Circle[{8+i,j },1/2],{i,1,7},{j,1,5,1+Sqrt[2]/2}],
Table[Circle[{8+i+1/2,j+Sqrt[3]/2},1/2],{i,1,7},{j,1,5,1+Sqrt[2]/2}],
Text["\!\(\*
StyleBox[\"square\",\nFontFamily->\"Times\",\nFontSize->14,\nFontSlant->\"Italic\"]\)\!\(\*
StyleBox[\" \",\nFontFamily->\"Times\",\nFontSize->14,\nFontSlant->\"Italic\"]\)\!\(\*
StyleBox[\"packing\",\nFontFamily->\"Times\",\nFontSize->14,\nFontSlant->\"Italic\"]\)",{4,-.2}],
Text["\!\(\*
StyleBox[\"hexagonal\",\nFontFamily->\"Times\",\nFontSize->14,\nFontSlant->\"Italic\"]\)\!\(\*
StyleBox[\" \",\nFontFamily->\"Times\",\nFontSize->14,\nFontSlant->\"Italic\"]\)\!\(\*
StyleBox[\"packing\",\nFontFamily->\"Times\",\nFontSize->14,\nFontSlant->\"Italic\"]\)",{12.4,-.2}]
},AspectRatio->Automatic]
]

Pretty Packing

Show[Graphics[Table[Circle[{i,j},.7],{i,5},{j,3}],AspectRatio->Automatic]]