Kiepert Parabola

Author

Eric W. Weisstein
December 13, 2004

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

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

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

Equation

Inconic parameters

{x,y,z}={a(b^2-c^2),b(c^2-a^2),c(a^2-b^2)};

Parabola identity

x/a+y/b+z/c

Trilinear Equations

eqn=ConicEquation[KiepertParabola]

Focus

{a^2/x,b^2/y,c^2/z}

Trilinears[X[110]]

Simplify[FullSimplify[TrigExpand[DistanceTrilinears[X[110]]],a>0&&b>0&&c>0]/Circumradius[{a,b,c}]/2]

Brianchon Point

1/{x,y,z}

CenterFunction[SteinerPoint]

Simplify[-((Trilinears[SteinerPoint])/((a^2-b^2)(a^2-c^2)(c^2-b^2)a b c))]

Envelope of Perspective Axes of Erected Isosceles Triangles

tri={{0,0},{1,0},{.4,.7}};
path={};
Export[gifs<>"kiepertp.gif",Table[Show[Graphics[{
{Thickness[.012],Triangle[tri]},
RGBColor[0,0,1],e=ErectScaleneTriangles[tri,h],
RGBColor[0,0,1],PointLabels[Flatten[Transpose[{v=Last@@@e,{"A'","B'","C'"}}],1],.03,.04],
Dashing[{.02,.02}],Triangle[v],
RGBColor[0,0,0],
PointLabels[Flatten[Transpose[{tri,{"A","B","C"}}],1],.03,.04],
Dashing[{}],RGBColor[1,0,0],
AppendTo[path,Line@LongestLine[PerspectiveAxisPoints[tri,Last@@@ErectScaleneTriangles[tri,h]],20]]
}/.Triangle:>polygon,AspectRatio->Automatic],PlotRange->{{-.5,1.5},{-.5,1}}],{h,-.1,-.7,-.02}]]

tri={{0,0},{1,0},{.4,.7}};
path={};
Do[
AppendTo[path,Line@LongestLine[PerspectiveAxisPoints[tri,Last@@@ErectScaleneTriangles[tri,h]],20]],{h,-.101,-.75,-.02}];

Show[Graphics[{{RGBColor[0,0,1],path},
PointLabels[Flatten[Transpose[{tri,{"A","B","C"}}],1],.03,.1{-1,-1}],
Thickness[.01],polygon[tri],
{Dashing[{.04,.04}],
Line[{tri[[#]],tri[[#]]+(tri[[#]]-tri[[1]])10}]&/@{2,3}},
RGBColor[1,0,0],
PointLabels[{KiepertParabolaFocus[tri],"F"},.03,.1],
EulerLine[tri,100,100]
},PlotRange->{{-.5,3},{-1,2}},AspectRatio->Automatic]]

Intersection of Parry Circle and Circumcircle

t=Triangle[{{0,0},{1,0},{.3,.5}}];
Show[Graphics[{
t,
{Red,ParryCircle[t]},
{Blue,Circumcircle[t]},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],
{
{IsodynamicPoint[1][t],"S",Red},
{IsodynamicPoint[2][t],"S'",Red},
{Centroid[t],"G",Red},
{ParryPoint[t],"P",Purple},
{X[110][t],"(Subscript[X, 110])",Purple}
}
],
{PointSize[.04],LabelOffset->-.08}
]
}],AspectRatio->Automatic,PlotRange->All]

Feuerbach Point of Tangential Triangle

t=Triangle[{{0,0},{1,0},{.3,.8}}];
Show[Graphics[{
t,
{Red,tt=TangentialTriangle[t]},
{Blue,Incircle[TangentialTriangle[t]]},
{DarkGreen,NinePointCircle[TangentialTriangle[t]]},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],
Append[#,Red]&/@Transpose[{Point/@Vertices[tt],{"(Subscript[T, 1])","(Subscript[T, 2])","(Subscript[T, 3])"}}],
{
{Incenter[tt],"(Subscript[I, T])",Blue},
{NinePointCenter[tt],"(Subscript[N, T])",DarkGreen},
{X[110][t],"F",Purple}
}
],
{PointSize[.025],LabelOffset->{-1,-.2}.09}
]
}],AspectRatio->Automatic]

Brianchon Point

Simplify[Together[Sin[A](Sin[B]^2-Sin[C]^2)/.{Sin[A]:>a,Sin[B]:>b,Sin[C]:>c}]]

a(b^2-c^2)/a+b(c^2-a^2)/b+c(a^2-b^2)/c

Equation of Tangent Lines

Solve[a(b^2-c^2)/α+b(c^2-a^2)/β+c(a^2-b^2)/γ==0,γ]

Show[Graphics[
{t,pts=Point/@Table[TrilinearToCartesian[t,{α,β,γ}/.{γ->(((a^2) c α β-(b^2) c α β)/((a^2) b α-b (c^2) α-a (b^2) β+a (c^2) β))}/.{α->Random[Real,{-3,3}],β->Random[Real,{-3,3}]}/.Thread[{a,b,c}->SideLengths[t]]],{1000}]

}],
AspectRatio->Automatic,PlotRange->{{-2,2},{-2,2}}]

Kimberling

Show[Graphics[
{Sides[t,1],
{Blue,t},
Red,Map[Point,Table[TrilinearToCartesian[t,{α,#,-1}]&/@(β/.Solve[TrilinearEquation[KiepertParabola]==0/.γ->-1/.Thread[{a,b,c}->SideLengths[t]],β])/.{α->Random[Real,{0,20}]},{100}],{2}]
}],
AspectRatio->Automatic,PlotRange->{{-2,2},{-2,2}}]

t=Triangle[{{0,0},{1,0},{.4,.7}}];
pts=Intersections@@@Transpose[{Sides[t],Line[{Coordinates[SteinerPoint[t]],#}]&/@Vertices[t]}];
Show[Graphics[{
t,
{Dashing[{.02}],Sides[t,5]},
{Red,
g=ParametricPlot[Evaluate[
TrilinearToCartesian[t,{α,#,-1}]&/@(β/.Solve[TrilinearEquation[KiepertParabola]==0/.γ->-1/.Thread[{a,b,c}->SideLengths[t]],β])],
{α,0,50},
PlotPoints->100,
DisplayFunction->Identity
][[1]],
Line[#[[1,-1]]&/@Flatten[g]]
},
{Red,EulerLine[t,3,3]},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"A","B","C"}}],
{
{X[110][t],"(Subscript[X, 110])",Red}
}
],
{PointSize[.025],LabelOffset->.1}
]
}],
PlotRange->{{-.5,2.5},{-.5,2}},
AspectRatio->Automatic]

pts

t=Triangle[{{0,0},{1,0},{4/10,7/10}}]//N[#,10]&;
pts=Intersections@@@Transpose[{Sides[t],Line[{Coordinates[SteinerPoint[t]],#}]&/@Vertices[t]}];
Show[Graphics[{
t,
{Dashing[{.02}],Sides[t,5]},
{Red,
g=ParametricPlot[Evaluate[
TrilinearToCartesian[t,{α,#,-1}]&/@(β/.Solve[TrilinearEquation[KiepertParabola]==0/.γ->-1/.Thread[{a,b,c}->SideLengths[Evaluate[t]]],β])],
{α,0,50},
PlotPoints->100,
DisplayFunction->Identity
][[1]],
Line[#[[1,-1]]&/@Flatten[g]]
},
{Purple,Circumcircle[t]},
{Green,SteinerTriangle[t]},
{Blue,LongestLine[{Sequence@@#,Coordinates[SteinerPoint[t]]}]&/@Transpose[{Vertices[t],Coordinates/@pts}]},
{Red,EulerLine[t]},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{pts,{"(Subscript[S, A])","(Subscript[S, B])","(Subscript[S, C])"}}],
{
{X[110][t],"(Subscript[X, 110])",Red},
{SteinerPoint[t],"S",{Purple,LabelOffset->{.1,.01}}}
}
],
{PointSize[.025],LabelOffset->.1}
]
}],
PlotRange->{{-.5,2.5},{-.5,2}},
AspectRatio->Automatic]

Contact Points

Factor[b ((a^2)-(c^2))First[{α,β,γ}/.Solve[TrilinearEquation[KiepertParabola]==0&&α==0&&γ==1,{α,β,γ}]]]

Factor[a (-(b^2)+(c^2))First[{α,β,γ}/.Solve[TrilinearEquation[KiepertParabola]==0&&β==0&&γ==1,{α,β,γ}]]]

Factor[a ((b^2)-(c^2))First[{α,β,γ}/.Solve[TrilinearEquation[KiepertParabola]==0&&γ==0&&β==1,{α,β,γ}]]]

Incident Centers

(ctrs=IncidentCenters[KimberlingCenters,TrilinearEquation[KiepertParabola]])//Timing

{#,CenterName[#]}&/@ctrs//TableForm

CenterName[X[110]]

Check

FullSimplify[Numerator[Together[ToSidelengths[TrigExpand[TrilinearEquation[KiepertParabola]/.Thread[{α,β,γ}->Trilinears[#]]]]]],TriangleQ[]]&/@ctrs//Timing