Nesting Regular Polygons and Circles

by George Beck

Circumscribe and Inscribe are functions that let you draw nested sequences of circles and regular polygons.

Circumscribe

Show @ Graphics @ Circumscribe[{3}, 1];

Show @ Graphics @ Circumscribe[{3,4,5}, 1];

Show @ Graphics @ Circumscribe[Table[7, {24}], 1];

Show @ Graphics @ Circumscribe[Range[3, 20], 1];

Inscribe

Show @ Graphics @ Inscribe[{3}, 1];

Show @ Graphics @ Inscribe[{3,5,3,5}, 1];

Show @ Graphics @ Inscribe[Table[6, {24}], 1];

Show @ Graphics @ Inscribe[Range[3, 12], 1];

Implementation

Usage messages

SetOptions[Graphics, AspectRatio -> Automatic, 
PlotRange -> All];

Circumscribe::usage = "CircumscribeAux[l, r] draws a 
list of nested polygons and circles. Each polygon is 
circumscribed about the previous circle, and each circle 
passes through the vertices of the previous polygon. The 
number of sides of the polygons comes from the list l, 
and the first circle has radius r.";

Inscribe::usage = "CircumscribeAux[l, r] draws a 
list of nested polygons and circles. Each polygon is 
inscribed in the previous circle, and each circle passes 
through the midpoints of the sides of the previous 
polygon. The number of sides of the polygons comes from 
the list l, and the first circle has radius r.";

Function definitions

Circumscribe[n_?NumberQ, r_] := Module[
	{a, vertices}, 
	a = 2 N[Pi] / n;
	vertices = Table[ 
		r Sec[a / 2] {Cos[i a], Sin[i a]}, 
		{i, 0, n}
	];
	{
		RGBColor[0,0,1],
		Line[vertices], 
		RGBColor[0,1,0],
		Circle[{0, 0}, r Sec[a / 2]]
	}
]

Circumscribe[{n_?NumberQ}, r_] := {Circumscribe[n, r]}

Circumscribe[l_List, r_] := Module[
	{k, c}, 
	{k, c} = Circumscribe[First @ l, r]; 
	Append[
			Circumscribe[Rest @ l, Last @ c], 
			{k, c}
	]
]

Inscribe[n_?NumberQ, r_] := Module[
	{a, vertices}, 
	a = 2 N[Pi] / n;
	vertices = Table[
		r {Cos[i a], Sin[i a]}, 
		{i, 0, n}
	];
	{
		RGBColor[1,0,0],
		Line[vertices],  
		RGBColor[0,1,0],
		Circle[{0, 0}, r Cos[a / 2]]
	}
]

Inscribe[{n_?NumberQ}, r_] := {Inscribe[n, r]}

Inscribe[l_List, r_] := Module[
	{k, c}, 
	{k, c} = Inscribe[First @ l, r]; 
	Append[
			Inscribe[Rest @ l, Last @ c], 
			{k, c}
	]
]