Inner Pentagon Point

Author

Eric W. Weisstein
November 19, 2005

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

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

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

Coordinates

Trilinears[X[1140]]

FullSimplify[%]

Figure

t=Triangle[{{0,0},{1,0},{4/10,8/10}}];
Show[Graphics[{
{Red,pent=ErectPolygons[t,5,-1]},
t,
{Blue,
LongestLine[Append[#,Coordinates[X[1140][t]]]]&/@Transpose[{Vertices[t],v=#[[3]]&/@Coordinates/@pent}]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{{X[1140][t],"(Subscript[X, 1140])",Blue}},
Append[#,Red]&/@Transpose[{Point/@v,{"A'","B'","C'"}}]
],PointSize[.025]]
}],AspectRatio->Automatic,ImageSize->250]

Derivation

TrilinearLine/@Sides[ReferenceTriangle]

Midpoints[ReferenceTriangle]

PerpendicularLine[TrilinearLine[{1,0,0}],{0,c,b}]

TrilinearEquation[%]

eqn=Factor[ToSidelengths[%]]

d2=Factor[Distance[{α,β,γ},{0,c,b}]^2]

r2R2=FullSimplify[((1/2)a (Cot[(π/5)]+Csc[(π/5)]))^2]

asoln=GroebnerBasis[{
Numerator[eqn],
ToSidelengths[(2Area)]-(a α+b β+c γ),
Numerator[d2]-Denominator[d2]r2R2
},{α},{β,γ},MonomialOrder->EliminationOrder]

Refine[Simplify[Solve[asoln[[1]]==0,α]],TriangleQ[]]

bsoln=GroebnerBasis[{
Numerator[eqn],
ToSidelengths[2Area]-(a α+b β+c γ),
Numerator[d2]-Denominator[d2]r2R2
},{β},{α,γ},MonomialOrder->EliminationOrder]

Refine[ToAngles[Simplify[Solve[bsoln[[1]]==0,β]]],Area>0&&TriangleQ[]]

csoln=GroebnerBasis[{
Numerator[eqn],
ToSidelengths[2Area]-(a α+b β+c γ),
Numerator[d2]-Denominator[d2]r2R2
},{γ},{α,β},MonomialOrder->EliminationOrder]

Refine[ToAngles[Simplify[Solve[csoln[[1]]==0,γ]]],Area>0&&TriangleQ[]]

tips=First/@CircleTriplet[{(1/2) (Sqrt[5+2 (Sqrt[5])]) a,((4 Area b-2 (Sqrt[5+2 (Sqrt[5])]) a (b^2) Cos[C])/(4 (b^2))),((4 Area c-2 (Sqrt[5+2 (Sqrt[5])]) a (c^2) Cos[B])/(4 (c^2)))},1];

t=Triangle[{{0,0},{1,0},{.3,.5}}];
Show[Graphics[{
{Red,pent=ErectPolygons[t,5,-1]},
t,
TrilinearCurve[t,eqn],
{Blue,
Line/@Transpose[{Vertices[t],v=#[[2]]&/@Coordinates/@pent}]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{{X[1139][t],"(Subscript[X, 1139])",Blue}},
{{Midpoints[t][[1]],"(Subscript[M, A])"}},Append[#,Red]&/@Transpose[{Point/@v,{"(Subscript[P, A])","(Subscript[P, B])","(Subscript[P, C])"}}],
Append[#,Green]&/@Transpose[{Cartesian[#[t]]&/@tips,{"E","F","G"}}]
],PointSize[.025]]
}],AspectRatio->Automatic,ImageSize->250,PlotRange->2{{-1,1},{-1,1}}]

lines=TrilinearLine/@(Line@@@Transpose[{tips,IdentityMatrix[3]}])

ConcurrentQ[lines]

Symmetrize[Intersections@@Take[lines,2]]

FullSimplify[Tan[2π/5]-(Sqrt[5+2 (Sqrt[5])])]

Cartesian[%%[t]]

X[1140][t]//N

Trilinears[X[1140]]