Neuberg Circle

Author

Eric W. Weisstein
December 9, 2004

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

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

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

Animation

NeubergAnimation::usage="NeubergAnimation[w,{v1,v2},step,<opts>] makes a movie of the contruction of the Neuberg circle for Brocard angle w on base {v1,v2}, 
with step radians and using graphics options opts."

NeubergAnimation[w_,{v2_,v3_},st_,opts___]:=Module[{n=NeubergCircle[w,{v2,v3}],v1,b},
Table[Show[Graphics[{
PointSize[.04],
Point[b=BrocardPoint[1,{v1=n[[1]]+n[[2]]{Cos[t],Sin[t]},v2,v3}][[1]]],
PointLabels[{b,"Ω",v1,"A1",v2,"A2",v3,"A3"},.04,.04],
BrocardAngles[1,{v1,v2,v3}],
AngleBisectorLabel[{"ω",.2},{b,v3,v1}],
AngleBisectorLabel[{"ω",.2},{b,v1,v2}],
AngleBisectorLabel[{"ω",.2},{b,v2,v3}],
Triangle[{v1,v2,v3}],
{Thickness[.02],Line[{v2,v3}]},
Point/@{v2,v3},
{RGBColor[1,0,0],n,Point[v1]}
},AspectRatio->Automatic],opts,PlotRange->All],
{t,0,2Pi-2Pi/st,2Pi/st}]
]

Export[gifs<>"neuberg.gif",NeubergAnimation[.5,{{0,0},{1,0}},20,PlotRange->{{-.1,1.1},{-.1,1.3}}]]

Show[GraphicsArray[Partition[NeubergAnimation[.5,{{0,0},{1,0}},6,PlotRange->{{-.1,1.1},{-.1,1.3}},DisplayFunction->Identity],3]]]

Figure

t=Triangle[{{0,0},{1,0},{.8,.6}}];
Show[GraphicsArray[Graphics[{
t,
{Red,
circs=NeubergCircles[#][t],
If[#==2,{{Blue,NeubergTriangle[2][t]},{Dashing[{.02,.05}],NeubergCircles[1][t]}},{Blue,NeubergTriangle[1][t]}]
},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],
Append[#,{Red}]&/@Transpose[{CircleCenter/@circs,Function[p,p<>If[#==1,"","'"]]/@{"(Subscript[N, 1])","(Subscript[N, 2])","(Subscript[N, 3])"}}]
],PointSize[.035]]
},AspectRatio->Automatic]&/@{1,2}]]

Neuberg Triangle

CircleCenter/@Circles[NeubergCircles[1]]

CircleCenter/@Circles[NeubergCircles[2]]

Radius

Circles[NeubergCircles[1]]

Circle Functions

eqns=Factor[Simplify[Together//@ToSidelengths[CircleEquation/@Circles[NeubergCircles[1]]],TriangleQ[]]]

lmn=Factor[CircleFunction/@eqns]

Incident Centers

Timing[IncidentCenters[KimberlingCenters,CircleEquation[#]]]&/@Circles[NeubergCircles[1]]

Timing[IncidentCenters[KimberlingCenters,CircleEquation[#]]]&/@Circles[NeubergCircles[2]]

Cartesian Derivation

s=(a[1]+a[2]+a[3])/2;

General Case

Solve[{
(x-x2)^2+(y-y2)^2==a3^2,
(x-x3)^2+(y-y3)^2==a2^2,
Cot[ω]==(a1^2+a2^2+a3^2)/4/Area[{a1,a2,a3}]},
{x},{a2,a3}]

gives a god-awful mess, so specialize to triangle with coordinates (0, 0), (1, 0), and (x, y).

Triangle with coordinates (0,0),(1,0),and (x,y).

Solve[{x^2+y^2==a[3]^2,(x-a[1])^2+y^2==a[2]^2,a[1]^2+a[2]^2+a[3]^2==4Sqrt[s(s-a[1])(s-a[2])(s-a[3])]Cot[ω]},x,{a[2],a[3]}]/.a[n_]:>Subscript[a,n]//TraditionalForm

Trilinear Derivation

Factor[Together//@(Distance[{0,1,0},{α,β,γ}]^2)]

Factor[Together//@(Distance[{0,0,1},{α,β,γ}]^2)]

Factor[Distance[{1,Cot[ω]}a/2,{#,0}]^2&/@{0,a}]

Factor[Together//@(Distance[{0,1,0},{α0,β0,γ0}]^2)]

Factor[Together//@(Distance[{0,0,1},{α0,β0,γ0}]^2)]

soln=Solve[{
(1/4) (a^2) (1+((Cot[ω])^2))==((a c (a c ((α0)^2)+(a^2) α0 γ0-(b^2) α0 γ0+(c^2) α0 γ0+a c ((γ0)^2)))/(((a α0+b β0+c γ0))^2))==((a b (a b ((α0)^2)+(a^2) α0 β0+(b^2) α0 β0-(c^2) α0 β0+a b ((β0)^2)))/(((a α0+b β0+c γ0))^2)),
2Area[]==a α0+b β0+c γ0
},{α0,β0,γ0}]

ctrs={α0,β0,γ0}/.soln/.ω->BrocardAngle[]

t=Triangle[{{.3,.5},{0,0},{1,0}}];
Point[n=TrilinearToCartesian[t,#]/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]]&/@ctrs

Together//@(2b c (Sqrt[-(a-b-c) (a+b-c) (a-b+c) (a+b+c)])ctrs){1,-1}

Factor[Together//@Sqrt[Cot[BrocardAngle[]]^2-3]a/2]

t=Triangle[{{0,0},{1,0},{.8,.6}}];
NeubergCircles[t]

CircleTriplet[{a b c ((a^2)+(b^2)+(c^2)),c (-(a^4)-(b^4)+(a^2) (c^2)+(b^2) (c^2)),b (-(a^4)+(a^2) (b^2)+(b^2) (c^2)-(c^4))},Sqrt[Cot[BrocardAngle[]]^2-3]a/2]

Through[CircleTriplet[{a b c ((a^2)+(b^2)+(c^2)),c (-(a^4)-(b^4)+(a^2) (c^2)+(b^2) (c^2)),b (-(a^4)+(a^2) (b^2)+(b^2) (c^2)-(c^4))},Sqrt[Cot[BrocardAngle[]]^2-3]a/2][t]]

t=Triangle[{{.3,.7},{0,0},{1,0}}];
Show[Graphics[{
t,
PointSize[.02],
Point[n=TrilinearToCartesian[t,{a b c ((a^2)+(b^2)+(c^2)),c (-(a^4)-(b^4)+(a^2) (c^2)+(b^2) (c^2)),b (-(a^4)+(a^2) (b^2)+(b^2) (c^2)-(c^4))}]/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]],
Circle[n,Sqrt[Cot[BrocardAngle[t]]^2-3]/2/a/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]]
}],AspectRatio->Automatic]