Griffiths' Theorem

Author

Eric W. Weisstein
February 4, 2003

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

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

Initialization

<<PlaneGeometry`

Code

GriffithsDiagram[t_Triangle,v_List,l_:1]:=Module[
{
o=Coordinates[Circumcenter[t]],
p,
c,
g=GriffithsPoint[t,v]
},
p=PedalTriangle[t,Point[o+v]];
c=Circumcircle[p];
{
t,
{Dashing[{.02}],Sides[t,1.5]},
{Red,p},
{Green,c},
Line[{o-l UnitVector[v],o+l UnitVector[v]}],
{Blue,NinePointCircle[t]},
{Red,Dashing[{.02}],PedalLines[t,Point[o+v]]},
PointLabels[{{g,"Gr",Blue},{Point[o],"O",Purple},{Point[o+v],"P",Red}},{PointSize[.03],LabelOffset->3{.03,.04}}]
}
]

GriffithsPoint[t_Triangle,v_List]:=Module[
{i,o=Coordinates@Circumcenter[t],c,n=NinePointCircle[t]},
c=Table[Circumcircle[PedalTriangle[t,Point[o+(-1)^i v]]],{i,2}];
Intersection[Sequence@@(Intersections[n,#]&/@c),
SameTest->(#.#&[Subtract@@(Coordinates/@{#1,#2})]<10^-8&)][[1]]
]

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

Diagram

t=Triangle[{{0,0},{1,0},{.7,.7}}];
Show[GraphicsArray[Partition[Table[Graphics[
	GriffithsDiagram[t,d{1,2},5],
PlotRange->{{-1.2,2.3},{-2.5,1}},
AspectRatio->Automatic],{d,-1,0,.3}],3]]]

movie=Show/@Table[Graphics[#,
AspectRatio->Automatic,
PlotRange->{{-2,2.5},{-2.5,2.5}}
]&/@
	GriffithsDiagram[t,d{1,2},5],{d,-1,1,.0300001}]

<<GIF`;

Export[gifs<>"griffith.gif",movie]//Timing