Neuberg Triangle

Author

Eric W. Weisstein
November 8, 2005

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

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

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

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}]]

Trilinear Vertex Matrix

TrilinearVertexMatrix[NeubergTriangle[1]]//TraditionalForm

TrilinearVertexMatrix[NeubergTriangle[2]]//TraditionalForm

Area

Neuberg Triangle

Map[Factor,Simplify[Together//@Area[NeubergTriangle[1]],TriangleQ[]],2]

Map[Factor,Simplify[((Area[]Csc[BrocardAngle[]]^2)/4),TriangleQ[]],2]

Side Lengths

Neuberg Triangle

Map[Factor,Together//@SideLengths[NeubergTriangle[1]],2]

Centroids Coincide

Show[GraphicsArray[Graphics[{
t,
{Red,NeubergCircles[t,#]},
{Blue,n=NeubergTriangle[t,#]},
{Dashing[{.02}],
Medians[t],
{Blue,Medians[n]}
},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],
Append[#,{Red}]&/@Transpose[{NeubergCenters[t,#],
Function[p,p<>If[#==1,"","'"]]/@{"(Subscript[N, 1])","(Subscript[N, 2])","(Subscript[N, 3])"}}],
{{Centroid[t],If[#==1,"(Subscript[G, A])=(Subscript[G, N])","(Subscript[G, A])=(Subscript[G, N'])"]}}
],PointSize[.035]]
},AspectRatio->Automatic]&/@{1,-1}]]

Tarry Point

lines=Line/@Transpose[{Vertices[t],Coordinates/@NeubergCenters[t]}]

{Intersections@@Take[lines,2],TarryPoint[t]}

Show[GraphicsArray[Graphics[{
lines=Line/@Transpose[{Vertices[t],Coordinates/@NeubergCenters[t,#]}];
{Red,
LongestLine/@(Function[l,Join[l,{Coordinates[If[#==1,TarryPoint[t],X[262][t]]]}]]/@Coordinates/@lines)
},
t,
{Blue,NeubergCircles[t,#],NeubergTriangle[t,#]},
PointLabels[Join[
Transpose[{Point/@Vertices[t],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[A, 3])"}}],
Append[#,{Red}]&/@Transpose[{NeubergCenters[t,#],Function[p,p<>If[#==1,"","'"]]/@{"(Subscript[N, 1])","(Subscript[N, 2])","(Subscript[N, 3])"}}],
{If[#==1,
{TarryPoint[t],"T",Purple},
{X[262][t],"(Subscript[X, 262])",Purple}]
}
],PointSize[.035]]
},AspectRatio->Automatic,PlotRange->All]&/@{1,-1}]]

Triangle Center Function for (Subscript[X, 262])

FullSimplify[PowerExpand[Together//@(TrigExpand[FullSimplify[Sec[A-ArcCot[(a^2+b^2+c^2)/4/TriangleArea[{a,b,c}]]]]]/.Sin[A]:>Sqrt[1-Cos[A]^2]/.Cos[A]:>(b^2+c^2-a^2)/2/b/c)]]

Centers

First

(pts={#,KimberlingLookup[#[NeubergTriangle[1]]]}&/@Take[KimberlingCenters,All]);//Timing

{#[[1]],Name[#[[1]]],X[#[[2,1]]],Name[X[#[[2,1]]]]}&/@Cases[pts,_?(Last[#]=!={}&)]//TableForm

Second

(pts={#,KimberlingLookup[#[NeubergTriangle[2]]]}&/@Take[KimberlingCenters,All]);//Timing

{#[[1]],Name[#[[1]]],X[#[[2,1]]],Name[X[#[[2,1]]]]}&/@Cases[pts,_?(Last[#]=!={}&)]//TableForm