Feuerbach Circle

Oliver Knill, MathE - 320, Harvard Extension School, Spring 2010-2011

LineIntersect[A1_,A2_,B1_,B2_]:=A1+(t/.Solve[A1+t (A2-A1)==B1+s (B2-B1),{t,s}][[1]]) (A2-A1);

Manipulate[Graphics[{m3=(p1+p2)/2;m2=(p1+p3)/2;m1=(p2+p3)/2;
h3=p1+(p2-p1) ((p3-p1).(p2-p1)/((p2-p1).(p2-p1)));
h1=p2+(p3-p2) ((p1-p2).(p3-p2)/((p3-p2).(p3-p2)));
h2=p3+(p1-p3) ((p2-p3).(p1-p3)/((p1-p3).(p1-p3)));
{x1,y1}=h1;{x2,y2}=h2;{x3,y3}=h3;
R=2*(x3*(y1-y2)+x1*(y2-y3)+x2*(-y1+y3));
n1=(x3^2*(y1-y2)+(x1^2+(y1-y2)*(y1-y3))*(y2-y3)+x2^2*(-y1+y3))/R;
n2=(-(x2^2*x3)+x1^2*(-x2+x3)+x3*(y1^2-y2^2)+x1*(x2^2-x3^2+y2^2-y3^2)+x2*(x3^2-y1^2+y3^2))/R;
center={n1,n2};radius=Sqrt[(center-h1).(center-h1)];
M=LineIntersect[p1,h1,p2,h2];
q1=(M+p1)/2;q2=(M+p2)/2;q3=(M+p3)/2;
{RGBColor[1,0,0],Dynamic[Disk[center,0.07]]},{RGBColor[1,0,0],Thickness[0.007],Dynamic[Circle[center,radius]]},{RGBColor[0,0,1],Dynamic[{Disk[p1,0.1],Disk[p2,0.1],Disk[p3,0.1]}]},{RGBColor[0,1,1],Dynamic[{Disk[m1,0.03],Disk[m2,0.03],Disk[m3,0.03]}]},{RGBColor[1,1,0],Dynamic[{Disk[h1,0.03],Disk[h2,0.03],Disk[h3,0.03]}]},{RGBColor[1,0,1],Dynamic[{Disk[q1,0.03],Disk[q2,0.03],Disk[q3,0.03]}]},{RGBColor[0,1,0],Thickness[0.004],Dynamic[Line[{p1,p2,p3,p1}]]},{RGBColor[0.5,0.5,0.5],Thickness[0.001],Dynamic[Line[{M,h1}]]},{RGBColor[0.5,0.5,0.5],Thickness[0.001],Dynamic[Line[{M,h2}]]},{RGBColor[0.5,0.5,0.5],Thickness[0.001],Dynamic[Line[{M,h3}]]},{RGBColor[0.5,0.5,0.5],Thickness[0.001],Dynamic[Line[{p1,M}]]},{RGBColor[0.5,0.5,0.5],Thickness[0.001],Dynamic[Line[{p2,M}]]},{RGBColor[0.5,0.5,0.5],Thickness[0.001],Dynamic[Line[{p3,M}]]},Locator[Dynamic[p1],ImageSize->40],Locator[Dynamic[p2],ImageSize->40],Locator[Dynamic[p3],ImageSize->40]},
PlotRange->{{-2,2},{-2,2}},ImageSize->{600,600}],{{p1,{1.1,0.6}},{-1,-1},{1,1},ControlType->None},{{p2,{-0.9,0.5}},{-1,-1},{1,1},ControlType->None},{{p3,{-0.3,1.2}},{-1,-1},{1,1},ControlType->None}]