Darboux Cubic

Author

Eric W. Weisstein
February 16, 2005

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

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

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

Pivot Point

CubicFunction[DarbouxCubic]

CenterFunction[DeLongchampsPoint]

Trilinear Equation

TrilinearEquation[DarbouxCubic]

Reflection of cubic in O

eqn0=Last[Factor[ToSidelengths[TrilinearEquation[DarbouxCubic]]]]

eqn1=Last[Factor[ToSidelengths[Factor[TrilinearEquation[DarbouxCubic]/.Thread[{α,β,γ}->Reflection[{α,β,γ},Trilinears[Circumcenter]]]][[2]]]]]

eqn1==eqn0

Incident Points

Centers

(ctrs=IncidentCenters[KimberlingCenters,DarbouxCubic])//Timing

First/@ctrs

Length[ctrs]

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

CenterName/@X/@{20,40}

Check

Simplify[DistanceTrilinears[TrigExpand[CubicEquation[DarbouxCubic]/.Thread[{α,β,γ}->Trilinears[#]]]],
TriangleQ[]]&/@ctrs//Timing

Graphic

Solve[cubic==0/.γ->1,β]

Branches[g_]:=Module[{data=Flatten[g][[1,1]]},
split=Split[data,Sqrt[#.#]&[Subtract@@@#]<10&];
{Line/@(Drop[#,-1]&/@split)
}
]

t=Triangle[{{0,0},{1,0},{.3,.6}}];
Show[Graphics[{
t,
{Red,
Branches[ParametricPlot[Evaluate[TrilinearToCartesian[t,{α,(-Cos[B]+(α^2) Cos[B]+Cos[A] Cos[C]-(α^2) Cos[A] Cos[C]-√((((Cos[B]-(α^2) Cos[B]-Cos[A] Cos[C]+(α^2) Cos[A] Cos[C]))^2)-4 (α Cos[A]+Cos[A] Cos[B]-Cos[C]-α Cos[B] Cos[C]) (-α Cos[A]-(α^2) Cos[A] Cos[B]+(α^2) Cos[C]+α Cos[B] Cos[C])))/(2 (α Cos[A]+Cos[A] Cos[B]-Cos[C]-α Cos[B] Cos[C])),1}/.Thread[{A,B,C}->Angles[t]]]],{α,-30,30},PlotRange->All,PlotPoints->100,
DisplayFunction->Identity][[1]]],
Branches[ParametricPlot[Evaluate[TrilinearToCartesian[t,{α,(-Cos[B]+(α^2) Cos[B]+Cos[A] Cos[C]-(α^2) Cos[A] Cos[C]+√((((Cos[B]-(α^2) Cos[B]-Cos[A] Cos[C]+(α^2) Cos[A] Cos[C]))^2)-4 (α Cos[A]+Cos[A] Cos[B]-Cos[C]-α Cos[B] Cos[C]) (-α Cos[A]-(α^2) Cos[A] Cos[B]+(α^2) Cos[C]+α Cos[B] Cos[C])))/(2 (α Cos[A]+Cos[A] Cos[B]-Cos[C]-α Cos[B] Cos[C])),1}/.Thread[{A,B,C}->Angles[t]]]],{α,-30,30},PlotRange->All,PlotPoints->100,
DisplayFunction->Identity][[1]]]
},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{Excenters[t],{"(Subscript[J, A])","(Subscript[J, B])","(Subscript[J, C])"}}],
Append[#,Red]&/@{
{Incenter[t],"I"},
{Circumcenter[t],"O"},
{Orthocenter[t],"H"},
{DeLongchampsPoint[t],"L"},
{BevanPoint[t],"V"}
}
],LabelOffset->.07,PointSize[.03]]
}],AspectRatio->Automatic,PlotRange->{{-.4,1.6},{-1.1,1.}},ImageSize->200]