Weill's Theorem

Author

Eric W. Weisstein
December 25, 2004

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

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

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

Code

Weill::usage="Weill[n,d,{a1,a2,...}] gives a plot of Weill's theorem for a bicentric polygon of n sides, center offset d, and a series of starting angles ai."

WeillCircle::usage="WeillCircle[n,d,{a1,a2,...}] gives a plot of Weill's theorem for a bicentric polygon of n sides, center offset d, and a series of starting angles ai.  The centroids are computed 2, 3, ..., n points at a time."

WeillPoint::usage="WeillPoint gives the Weill point for the specified triangle."

Weill[s_,x_,ang_List]:=Module[{n=Length[ang],l,t,i},l=Table[PonceletTransverseLines[s,x,PonceletClosed[s,x],ang[[i]]],{i,n}];
t=Table[PonceletTangents[s,x,PonceletClosed[s,x],ang[[i]]],{i,n}];
{Circle[{0,0},1],Circle[{x,0},PonceletClosed[s,x]],l,{PointSize[.03],Table[{GrayLevel[(n-i)/n],Point/@t[[i]],Point[Centroid[t[[i]]]]},{i,n}]}}]

WeillCircle[s_,x_,ang_List]:=Module[{n=Length[ang],l,t,i,j,sub},sub=Select[Subsets[Range[s]],Length[#]>1&];
l=Table[PonceletTransverseLines[s,x,PonceletClosed[s,x],ang[[i]]],{i,n}];
t=Table[PonceletTangents[s,x,PonceletClosed[s,x],ang[[i]]],{i,n}];
{Circle[{0,0},1],Circle[{x,0},PonceletClosed[s,x]],l,{PointSize[.03],Table[{GrayLevel[(n-i)/n],Point/@t[[i]],Point/@Table[Centroid[t[[i]][[sub[[j]]]]],{j,Length[sub]}]},{i,n}]}}]

Graphics

Show[GraphicsArray[{
		Show[Graphics[Weill[3,.3,{0,.3,.6,-.4}]],
				AspectRatio->Automatic,DisplayFunction->Identity],
		Show[Graphics[Weill[4,.3,{0,.3,-.2,-.4}]],
				AspectRatio->Automatic,DisplayFunction->Identity]
		}]]

Show[GraphicsArray[{
		Show[Graphics[WeillCircle[3,.3,{0,.3,.6,-.4}]],
				AspectRatio->Automatic,DisplayFunction->Identity],
		Show[Graphics[WeillCircle[4,.3,{0,-.3,.3,.2,-.1}]],
				AspectRatio->Automatic,DisplayFunction->Identity]
		}]]