Pappus Chain

Author

Eric W. Weisstein
March 27, 2003

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/PappusChain.nb.

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

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

Initialization

<<Arbelos`

Figure

r=.65;
Show[GraphicsArray[{
	Show[Graphics[{Arbelos[r],PappusChain[20,r],
		Table[PappusLetter[i,r],{i,6}]
		}],AspectRatio->Automatic,DisplayFunction->Identity],
Show[Graphics[{Arbelos[r],PappusChain[20,r],
		{PointSize[.03],Point/@Table[PappusCtr[i,r],{i,0,6}]},
			{Dashing[{.02,.02}],PappusEllipse[r]}
		}],AspectRatio->Automatic,DisplayFunction->Identity,
			PlotRange->All]}]]

Ellipse

Foci

a=(1+r)/4;
b=Sqrt[r]/2;
c=Simplify[Sqrt[a^2-b^2],0<r<1]

Simplify[(1+r)/4+#c&/@{-1,1}]

Sangaku

Show[Graphics[{
Table[ArbelosSemicircle[n,r],{n,0,2}],
Table[PappusCircle[n,r],{n,20}] /. Circle[x_,y_]:>{{GrayLevel[.7],Disk[x,y]},Circle[x,y]},
Line[{{0,0},{1,0}}],
Table[PappusTangentCircle[n,r],{n,10}]/.Circle[x_,y_]:>{{Red,Disk[x,y]},Circle[x,y]}
} /. {r->.7}],
AspectRatio->Automatic]

Table[Simplify[Together//@ApolloniusCircleInner[{PappusCircle[n-1,r],PappusCircle[n,r],PappusTangentCircle[n,r]}]],{n,5}]

Factor[FiniteRecognize[{6,18,30,42,54},n]]

Factor[FiniteRecognize[{9,33,81,153,249},n]]

Factor[FiniteRecognize[{1,49,145,289,481},n]]

Factor[FiniteRecognize[{4,28,76,148,244},n]]

FullSimplify[3 (3-4 n+4 (n^2))-r (1-24 n+24 (n^2))+(r^2) (4 (1-3 n+3 (n^2)))]

PappusTangentCircle[2,n_,r_]:=Module[{d=9-12 n (((-1+r))^2)+12 (n^2) (((-1+r))^2)+r (-1+4 r)},
Circle[{r(17+7r)/2/d,6 (2 n-1)(1-r)r/d},r(1-r)/d/2]
];

Show[Graphics[{
Table[ArbelosSemicircle[n,r],{n,0,2}],
Table[PappusCircle[n,r],{n,20}] /. Circle[x_,y_]:>{{GrayLevel[.7],Disk[x,y]},Circle[x,y]},
Line[{{0,0},{1,0}}],
Table[PappusTangentCircle[n,r],{n,10}]/.Circle[x_,y_]:>{{RGBColor[1,0,0],Disk[x,y]},Circle[x,y]},
Table[PappusTangentCircle[1,n,r],{n,10}]/.Circle[x_,y_]:>{{Green,Disk[x,y]},Circle[x,y]},
Table[PappusTangentCircle[2,n,r],{n,10}]/.Circle[x_,y_]:>{{Blue,Disk[x,y]},Circle[x,y]},
Table[PappusTangentCircle[3,n,r],{n,10}]/.Circle[x_,y_]:>{{Yellow,Disk[x,y]},Circle[x,y]}
} /. {r->.7}],
AspectRatio->Automatic]