Icosahedral Equation

Author

Eric W. Weisstein
May 19, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/IcosahedralEquation.nb.

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

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

Initialization

Code

Projection[v_List,r_:1]:={#[[1]],#[[2]]}/(1+#[[3]]/r)&/@Select[Simplify[v],#[[3]]≠-r&]

R=Sqrt[10+2Sqrt[5]]/4;
r=(3Sqrt[3]+Sqrt[15])/12;
ρ=(1+Sqrt[5])/4;

{R,r,ρ}//N

Project[icos_,r_,opts___]:=Module[{},
Graphics[{
PointSize[.05],
Map[Line,Map[Function[f,Projection[f,r]],PolyhedronEdges[icos],{1}]/r,{1}],
{PointSize[.07],Point/@VertexProjections[icos,r]},
{Red,Point/@FaceCenterProjections[icos,r]},
{Blue,Point/@EdgeMidpointProjections[icos,r]}
},
opts,
AspectRatio->Automatic,
PlotRange->All]
]

VertexProjections[icos_,r_]:=
Projection[PolyhedronVertices[icos],r]/r

FaceCenterProjections[icos_,r_]:=
Projection[PolyhedronFaceCenters[icos],r]/r

EdgeMidpointProjections[icos_,r_]:=
Projection[Midpoint/@PolyhedronEdges[icos],r]/r

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

(Subscript[C, 5])Projections

Off[$MaxExtraPrecision::"meprec"]

With[{i=IcosahedronExact},
Show[GraphicsArray[{{
Graphics3D[{
i,
PointSize[.05],
Point/@PolyhedronVertices[i],
{Red,Point/@PolyhedronFaceCenters[i]},
{Blue,Point/@Midpoint/@PolyhedronEdges[i]}
},Boxed->False,ViewPoint->{0,0,2}],
Graphics[HiddenWireframe[i,ViewPoint->{0,0,2},
PlotStyles->{{},Dashing[{1,1}.04]}],AspectRatio->Automatic]
}
}
]]]

Show[GraphicsArray[Project[IcosahedronExact,#]&/@{R,ρ,r}]]

Vertices

Simplify[Expand[Times@@(Flatten/@VertexProjections[IcosahedronExact,R]/.{x_,y_}:>(z-(x+I y)))]]

f[u_,v_]:=u v (u^10+11 u^5 v^5-v^10)

f[z,1]

Face Centers

Timing[RootReduce/@Times@@(Flatten/@FaceCenterProjections[Exact,r]/.{x_,y_}:>(z-(x+I y)))]

h1=RootReduce[(z+Root[1-3 #1-((#1)^2)+3 ((#1)^3)+((#1)^4)&,1]) (z+Root[1-3 #1-((#1)^2)+3 ((#1)^3)+((#1)^4)&,2]) (z+Root[1-3 #1-((#1)^2)+3 ((#1)^3)+((#1)^4)&,3]) (z+Root[1-3 #1-((#1)^2)+3 ((#1)^3)+((#1)^4)&,4])];

h2=RootReduce[(z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,1]) (z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,2]) (z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,3]) (z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,4]) (z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,5]) (z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,6]) (z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,7]) (z+Root[1+4 #1+7 ((#1)^2)+2 ((#1)^3)+15 ((#1)^4)-2 ((#1)^5)+7 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,8])];

h3=RootReduce[(z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,1]) (z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,2]) (z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,3]) (z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,4]) (z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,5]) (z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,6]) (z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,7]) (z+Root[1-#1+7 ((#1)^2)+7 ((#1)^3)-7 ((#1)^5)+7 ((#1)^6)+((#1)^7)+((#1)^8)&,8])];

{h1,h2,h3}

FullSimplify[h1 h2 h3]

H[u_,v_]:=u^20+v^20+228(u^5 v^15-u^15 v^5)+494 u^10 v^10

Collect[H[z,1],z]

Edge Midpoints

Timing[tt=RootReduce/@Times@@(Flatten/@EdgeMidpointProjections[IcosahedronExact,ρ]/.{x_,y_}:>(z-(x+I y)))]

t1=RootReduce[(-I+z) (I+z) ];
t2=RootReduce[(z+Root[1+2 #1-6 ((#1)^2)-2 ((#1)^3)+((#1)^4)&,1]) (z+Root[1+2 #1-6 ((#1)^2)-2 ((#1)^3)+((#1)^4)&,2]) (z+Root[1+2 #1-6 ((#1)^2)-2 ((#1)^3)+((#1)^4)&,3]) (z+Root[1+2 #1-6 ((#1)^2)-2 ((#1)^3)+((#1)^4)&,4])];
t3=RootReduce[(z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,1]) (z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,2]) (z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,3]) (z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,4]) (z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,5]) (z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,6]) (z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,7]) (z+Root[1-((#1)^2)+((#1)^4)-((#1)^6)+((#1)^8)&,8])];
t4=RootReduce[(z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,1]) (z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,2]) (z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,3]) (z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,4]) (z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,5]) (z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,6]) (z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,7]) (z+Root[1+4 #1+17 ((#1)^2)+22 ((#1)^3)+5 ((#1)^4)-22 ((#1)^5)+17 ((#1)^6)-4 ((#1)^7)+((#1)^8)&,8])];
t5=RootReduce[(z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,1]) (z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,2]) (z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,3]) (z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,4]) (z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,5]) (z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,6]) (z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,7]) (z+Root[1-6 #1+17 ((#1)^2)-18 ((#1)^3)+25 ((#1)^4)+18 ((#1)^5)+17 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,8])];

{t1,t2,t3,t4,t5}

FullSimplify[t1 t2 t3 t4 t5]

T[u_,v_]:=u^30+v^30+522 (u^25 v^5-u^5 v^25)-10005 (u^20 v^10+u^10 v^20)

Collect[T[z,1],z]

(Subscript[C, 3])Projections

Off[$MaxExtraPrecision::"meprec"]

With[{i=IcosahedronExact2},
Show[GraphicsArray[{{
Graphics3D[{
i,
PointSize[.05],
Point/@PolyhedronVertices[i],
{Red,Point/@PolyhedronFaceCenters[i]},
{Blue,Point/@Midpoint/@PolyhedronEdges[i]}
},Boxed->False,ViewPoint->{0,0,2}],
Graphics[HiddenWireframe[i,ViewPoint->{0,0,2},
PlotStyles->{{},Dashing[{1,1}.04]}],AspectRatio->Automatic]
}
}
]]]

Show[GraphicsArray[Project[IcosahedronExact2,#]&/@{R,ρ,r}]]

Vertices

RootReduce/@Times@@(Flatten/@VertexProjections[IcosahedronExact2,R]/.{x_,y_}:>(z-(x+I y)))

v1=RootReduce[Expand[(z+Root[1+3 #1-((#1)^2)-3 ((#1)^3)+((#1)^4)&,2]) (z+Root[1+3 #1-((#1)^2)-3 ((#1)^3)+((#1)^4)&,4]) ]];
v2=RootReduce[Expand[(z+Root[1-3 #1-((#1)^2)+3 ((#1)^3)+((#1)^4)&,2]) (z+Root[1-3 #1-((#1)^2)+3 ((#1)^3)+((#1)^4)&,4]) ]];
v3=RootReduce[Expand[(z+Root[1+3 #1+10 ((#1)^2)+3 ((#1)^3)+9 ((#1)^4)-3 ((#1)^5)+10 ((#1)^6)-3 ((#1)^7)+((#1)^8)&,1]) (z+Root[1+3 #1+10 ((#1)^2)+3 ((#1)^3)+9 ((#1)^4)-3 ((#1)^5)+10 ((#1)^6)-3 ((#1)^7)+((#1)^8)&,2]) (z+Root[1+3 #1+10 ((#1)^2)+3 ((#1)^3)+9 ((#1)^4)-3 ((#1)^5)+10 ((#1)^6)-3 ((#1)^7)+((#1)^8)&,5]) (z+Root[1+3 #1+10 ((#1)^2)+3 ((#1)^3)+9 ((#1)^4)-3 ((#1)^5)+10 ((#1)^6)-3 ((#1)^7)+((#1)^8)&,6])] ];
v4=RootReduce[Expand[(z+Root[1-3 #1+10 ((#1)^2)-3 ((#1)^3)+9 ((#1)^4)+3 ((#1)^5)+10 ((#1)^6)+3 ((#1)^7)+((#1)^8)&,1]) (z+Root[1-3 #1+10 ((#1)^2)-3 ((#1)^3)+9 ((#1)^4)+3 ((#1)^5)+10 ((#1)^6)+3 ((#1)^7)+((#1)^8)&,2]) (z+Root[1-3 #1+10 ((#1)^2)-3 ((#1)^3)+9 ((#1)^4)+3 ((#1)^5)+10 ((#1)^6)+3 ((#1)^7)+((#1)^8)&,5]) (z+Root[1-3 #1+10 ((#1)^2)-3 ((#1)^3)+9 ((#1)^4)+3 ((#1)^5)+10 ((#1)^6)+3 ((#1)^7)+((#1)^8)&,6])]];

vv1=RootReduce/@Collect[v1 v2,z]

vv2=RootReduce/@Collect[RootReduce/@Collect[v3 v4,z],z]

Collect[FullSimplify[vv1 vv2],z]

Face Centers

fc=RootReduce/@Times@@(Flatten/@FaceCenterProjections[IcosahedronExact2,r]/.{x_,y_}:>(z-(x+I y)))

fc1=RootReduce/@Collect[(z+Root[4-6 #1+5 ((#1)^2)-3 ((#1)^3)+((#1)^4)&,3]) (z+Root[4-6 #1+5 ((#1)^2)-3 ((#1)^3)+((#1)^4)&,4]) (z+Root[4+6 #1+5 ((#1)^2)+3 ((#1)^3)+((#1)^4)&,3]) (z+Root[4+6 #1+5 ((#1)^2)+3 ((#1)^3)+((#1)^4)&,4]) ,z]

fc2=RootReduce/@Collect[
(z+Root[1-3 #1+8 ((#1)^2)-3 ((#1)^3)+((#1)^4)&,3]) (z+Root[1-3 #1+8 ((#1)^2)-3 ((#1)^3)+((#1)^4)&,4]) (z+Root[1-3 #1+5 ((#1)^2)-6 ((#1)^3)+4 ((#1)^4)&,1]) (z+Root[1-3 #1+5 ((#1)^2)-6 ((#1)^3)+4 ((#1)^4)&,2]) ,z]

fc3=RootReduce/@Collect[
 (z+Root[1+3 #1+8 ((#1)^2)+3 ((#1)^3)+((#1)^4)&,3]) (z+Root[1+3 #1+8 ((#1)^2)+3 ((#1)^3)+((#1)^4)&,4]) 
(z+Root[1+3 #1+5 ((#1)^2)+6 ((#1)^3)+4 ((#1)^4)&,1]) (z+Root[1+3 #1+5 ((#1)^2)+6 ((#1)^3)+4 ((#1)^4)&,2]),z]

fc4=RootReduce/@Collect[z ((1/2) (-3-(Sqrt[5]))+z) ((1/2) (3-(Sqrt[5]))+z) (z+Root[4-((#1)^2)+((#1)^4)&,1]) (z+Root[4-((#1)^2)+((#1)^4)&,2])(z+Root[1-((#1)^2)+4 ((#1)^4)&,3]) (z+Root[1-((#1)^2)+4 ((#1)^4)&,4]),z]

Expand[8RootReduce[Collect[(RootReduce/@Collect[fc2 fc3,z])(RootReduce/@Collect[fc1 fc4,z]),z]]]

Edge Midpoints

em=RootReduce/@Times@@(Flatten/@EdgeMidpointProjections[IcosahedronExact2,ρ]/.{x_,y_}:>(z-(x+I y)))

em1=RootReduce/@Collect[ (z+Root[1-((#1)^2)+((#1)^4)&,1]) (z+Root[1-((#1)^2)+((#1)^4)&,2]) (z+Root[1-((#1)^2)+((#1)^4)&,3]) (z+Root[1-((#1)^2)+((#1)^4)&,4]) ,z]

em11=RootReduce/@Collect[(z+Root[1+6 #1+2 ((#1)^2)-6 ((#1)^3)+((#1)^4)&,1]) (z+Root[1+6 #1+2 ((#1)^2)-6 ((#1)^3)+((#1)^4)&,3]) (z+Root[1-6 #1+2 ((#1)^2)+6 ((#1)^3)+((#1)^4)&,1]) (z+Root[1-6 #1+2 ((#1)^2)+6 ((#1)^3)+((#1)^4)&,3]) ,z]

em2=RootReduce/@Collect[(z+Root[1+6 #1+34 ((#1)^2)+24 ((#1)^3)+39 ((#1)^4)-24 ((#1)^5)+34 ((#1)^6)-6 ((#1)^7)+((#1)^8)&,3]) (z+Root[1+6 #1+34 ((#1)^2)+24 ((#1)^3)+39 ((#1)^4)-24 ((#1)^5)+34 ((#1)^6)-6 ((#1)^7)+((#1)^8)&,4]) (z+Root[1+6 #1+34 ((#1)^2)+24 ((#1)^3)+39 ((#1)^4)-24 ((#1)^5)+34 ((#1)^6)-6 ((#1)^7)+((#1)^8)&,7]) (z+Root[1+6 #1+34 ((#1)^2)+24 ((#1)^3)+39 ((#1)^4)-24 ((#1)^5)+34 ((#1)^6)-6 ((#1)^7)+((#1)^8)&,8])  ,z]

em3=RootReduce/@Collect[(z+Root[1-6 #1+34 ((#1)^2)-24 ((#1)^3)+39 ((#1)^4)+24 ((#1)^5)+34 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,3]) (z+Root[1-6 #1+34 ((#1)^2)-24 ((#1)^3)+39 ((#1)^4)+24 ((#1)^5)+34 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,4]) (z+Root[1-6 #1+34 ((#1)^2)-24 ((#1)^3)+39 ((#1)^4)+24 ((#1)^5)+34 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,7]) (z+Root[1-6 #1+34 ((#1)^2)-24 ((#1)^3)+39 ((#1)^4)+24 ((#1)^5)+34 ((#1)^6)+6 ((#1)^7)+((#1)^8)&,8]) ,z]

em4=RootReduce/@Collect[(z+Root[4-8 ((#1)^2)+57 ((#1)^4)-8 ((#1)^6)+4 ((#1)^8)&,3]) (z+Root[4-8 ((#1)^2)+57 ((#1)^4)-8 ((#1)^6)+4 ((#1)^8)&,4]) (z+Root[4-8 ((#1)^2)+57 ((#1)^4)-8 ((#1)^6)+4 ((#1)^8)&,7]) (z+Root[4-8 ((#1)^2)+57 ((#1)^4)-8 ((#1)^6)+4 ((#1)^8)&,8]),z]

em5=RootReduce/@Collect[(z+Root[4+12 #1+22 ((#1)^2)+30 ((#1)^3)+9 ((#1)^4)-30 ((#1)^5)+22 ((#1)^6)-12 ((#1)^7)+4 ((#1)^8)&,3]) (z+Root[4+12 #1+22 ((#1)^2)+30 ((#1)^3)+9 ((#1)^4)-30 ((#1)^5)+22 ((#1)^6)-12 ((#1)^7)+4 ((#1)^8)&,4]) (z+Root[4+12 #1+22 ((#1)^2)+30 ((#1)^3)+9 ((#1)^4)-30 ((#1)^5)+22 ((#1)^6)-12 ((#1)^7)+4 ((#1)^8)&,5]) (z+Root[4+12 #1+22 ((#1)^2)+30 ((#1)^3)+9 ((#1)^4)-30 ((#1)^5)+22 ((#1)^6)-12 ((#1)^7)+4 ((#1)^8)&,6]) ,z]

em6=RootReduce/@Collect[(z+Root[4-12 #1+22 ((#1)^2)-30 ((#1)^3)+9 ((#1)^4)+30 ((#1)^5)+22 ((#1)^6)+12 ((#1)^7)+4 ((#1)^8)&,1]) (z+Root[4-12 #1+22 ((#1)^2)-30 ((#1)^3)+9 ((#1)^4)+30 ((#1)^5)+22 ((#1)^6)+12 ((#1)^7)+4 ((#1)^8)&,2]) (z+Root[4-12 #1+22 ((#1)^2)-30 ((#1)^3)+9 ((#1)^4)+30 ((#1)^5)+22 ((#1)^6)+12 ((#1)^7)+4 ((#1)^8)&,7]) (z+Root[4-12 #1+22 ((#1)^2)-30 ((#1)^3)+9 ((#1)^4)+30 ((#1)^5)+22 ((#1)^6)+12 ((#1)^7)+4 ((#1)^8)&,8]),z]

6 4+2

Expand[8RootReduce/@Collect[(-I+z) (I+z)  em1 em11 RootReduce/@Collect[em2 em3,z]em4 RootReduce/@Collect[em5 em6,z],z]]