Icosahedral Graph

Author

Eric W. Weisstein
June 21, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/IcosahedralGraph.nb.

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

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

Embeddings

<<MathWorld`Graphs`

Names

GraphData["IcosahedralGraph","StandardName"]

GraphData["IcosahedralGraph","StandardNames"]

Primary

GraphData["IcosahedralGraph"]//StyleGraphs[#,ImageSize->Small]&

Construction from Read and Wilson

All

GraphData["IcosahedralGraph","Graph","All"]//StyleGraphs

Inexact

Select[GraphData["IcosahedralGraph","Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData["IcosahedralGraph","EdgeList"]]

Default embedding

GraphPlot@GraphData["IcosahedralGraph","Edges"]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

v=Join[UnitCirclePoints[6,0],CirclePoints[{1/2,0},6]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[{1,6},1,7,9,11,7,2,9,4,11,6,7],e[6,12,8,10,12],{2,8},{3,9},{4,10},{5,11},e[12,5,10,3,8,1,12]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

v[[{8,9,10}]][[All,1]]

v=Join[UnitCirclePoints[6],CirclePoints[{1/2,0},3],CirclePoints[{1/4,Pi},3]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[{1,6},1,7,3,8,5,9,1],e[10,11,12,10,5],e[6,9,10,8,12,7,11,9],e[6,4,2,6],{1,11},{3,12},{2,7},{4,8}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

v=Join[UnitCirclePoints[6],CirclePoints[1/4,6]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[{1,6},1,8,3,10,5,12,1,7,9,11,7],e[6,12,8,10,12],e[11,4,9,2,7,6,11],{5,11},{4,10},{3,9},{2,8}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

v=Join[UnitCirclePoints[6],CirclePoints[1/4,6]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,3,5,1,8,3,10,5,12,1,7,8,9,10,11,12,7,2,9,4,11,6,7],e[2,4,6,2,8],{3,9},{4,10},{6,12},{5,11}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RegionIntersection[Line@v[[{5,10}]],Line@v[[{6,8}]]]//FullSimplify

v=Join[UnitCirclePoints[4,0],CirclePoints[1/3,4],{0,#/3/(Sqrt[2])}&/@{-1,1},{#,#}(1/(9 (Sqrt[2])))&/@{-1,1}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,4,1,6,2,7,3,8,4,5,1,3],e[5,6,10,7,8,9,5,12,10,11],e[7,11,9,12],e[8,11,12,6],{2,10},{4,9}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RegionIntersection[Line@v[[{1,3}]],Line@v[[{2,6}]]]

v=Join[UnitCirclePoints[6,Pi/2],{{-(1/(2 (Sqrt[3]))),(1/2)},{(1/(2 (Sqrt[3]))),(1/2)},{-(1/(2 (Sqrt[3]))),-(1/2)},{(1/(2 (Sqrt[3]))),-(1/2)},{0,1/6},{0,-1/6}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,4,5,6,1,7,3,9,10,5,8,1],e[4,10,6,8,7,2,9,4,12],e[3,12,5],e[2,11,6],e[7,12,8],{1,11},e[9,11,10]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

v=Join[UnitCirclePoints[10,Pi/2],{0,#/2}&/@{-1,1}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[{1,10},1,12],e[1,3,5,7,9,1],e[2,4,6,8,10,2],{6,11},e[2,11,10],e[5,12,7],e[3,12,9],e[4,11,8]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Degenerate

GraphData["IcosahedralGraph","Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData["IcosahedralGraph","Graph","Bilateral"]//StyleGraphs

Circular

GraphData["IcosahedralGraph","Graph","Circular"]//StyleGraphs

Planar

GraphData["IcosahedralGraph","Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData["IcosahedralGraph"]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData["IcosahedralGraph"],"OuterFace"->#]&/@faces

gs=Annotate[#,VertexLabels->None]&/@{}

Tutte embedding construction 3

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

MinimalCrossing

GraphData["IcosahedralGraph","Graph","MinimalCrossing"]//StyleGraphs

MinimalIntegral

GraphData["IcosahedralGraph","Graph","MinimalIntegral"]//StyleGraphs

IntegralDrawing/@GraphData["IcosahedralGraph","Graph","MinimalIntegral"]//StyleGraphs

1

ShowLabeledGraph[g=With[{h=(Sqrt[48]),x=5/2,y=((5 (Sqrt[3]))/2)},Graph[List/@{{1,7},{2,8},{7,3},{1,3},{2,4},{4,8},{7,6},{6,1},{2,5},{5,8},{6,5},{3,4}},List/@{{-3,0},{3,0},{-4,h},{4,h},{4,-h},{-4,-h},{-5,0},{5,0}}]]]

With[{h=(Sqrt[48])},Solve[{
(x-4)^2+(y-h)^2==3^2,
(x-5)^2+y^2==5^2},
{x,y}]]

With[{h=(Sqrt[48])},Solve[{
(x-3)^2+y^2==3^2,
(x-4)^2+(y-h)^2==5^2},
{x,y}]]

ShowLabeledGraph[g1=With[{h=(Sqrt[48]),x=5/2,y=((5 (Sqrt[3]))/2),x2=3/2,y2=3(Sqrt[3])/2},Graph[List/@{{1,7},{2,8},{7,3},{1,3},{2,4},{4,8},{7,6},{6,1},{2,5},{5,8},{6,5},{3,4},{6,11},{11,5},{6,9},{9,12},{12,3},{12,1},{9,5},{7,10},{12,4},{11,2},{9,1},{10,4},{10,2},{7,11},{9,8},{8,12},{10,3},{10,11}},List/@{{-3,0},{3,0},{-4,h},{4,h},{4,-h},{-4,-h},{-5,0},{5,0},{x,-y},{x2,y2},{-x,-y},{-x2,y2}}]]]

RecognizeGraph[g]

v=Vertices[g];
Norm/@Subtract@@@(v[[#]]&/@Edges[g])

Select[Edges[g],!IntegerQ[Simplify[Norm[Subtract@@v[[#]]]]]&]

2

Solve[{x^2+h^2==7^2,(8-x)^2+h^2==6^2},{x,h}]

Solve[{z^2+y^2==4^2,(8-z)^2+y^2==8^2},{z,y}]

Solve[{w^2+l^2==4^2,(8-w)^2+l^2==6^2},{w,l}]

ShowLabeledGraph[g2=With[{x=77/16,h=21(Sqrt[15])/16,z=1,y=(Sqrt[15])},Module[{
l=((3 (Sqrt[15]))/4)+h,w=(11/4)+x},
Graph[List/@{{10,9},{9,4},{4,3},{3,1},{1,11},{11,10},{10,8},{11,8},{11,12},{12,10},{1,5},{5,11},{5,6},{6,4},{2,4},{6,9},{9,7},{2,7},{7,4},{7,10},{12,9},{5,12},{2,1},{2,3},{1,8},{6,3},{6,12},{8,2},{3,5},{7,8}},List/@{{0,0},{x,h},{8,0},{x+8,h},{z,y},{z+8,y},{w,l},{w-8,l},{w+z,l+y},{w+z-8,l+y},{w+z-8-x,l+y-h},{w+z-x,l+y-h}}]]]]

RecognizeGraph[g]

Degrees[g]

v=Vertices[g];
Norm/@Subtract@@@(v[[#]]&/@Edges[g])

Select[Edges[g],!IntegerQ[Simplify[Norm[Subtract@@v[[#]]]]]&]

All

v=Vertices[g1];
gr1=Show[{GraphPlot[g1,Method->None],Graphics[Text[" "<>ToString[Norm[Subtract@@v[[#]]]]<>" ",Mean[v[[#1]]],Background->White]&/@Edges[g1]]}]

v=Vertices[g2];
gr2=Show[{GraphPlot[g2,Method->None],Graphics[Text[" "<>ToString[Norm[Subtract@@v[[#]]]]<>" ",Mean[v[[#1]]],Background->White]&/@Edges[g2]]}]

GraphicsGrid[{{gr1,gr2}},Spacings->-60,ImageSize->400]

newe=ToCommonEdges[#,"IcosahedralGraph"]&/@{g1,g2}

GetGraphData["IcosahedralGraph","File"]

e=GraphData["IcosahedralGraph","Embeddings"];

Join[Take[e,9],newe,Drop[e,9]]

MinimalPlanarIntegral

v={{22.2247`,61.4484`},{1631.76`,56.7695`},{829.333`,1441.72`},{473.737`,410.026`},{553.278`,264.98`},{1098.37`,269.659`},{1182.59`,405.347`},{908.874`,891.951`},{745.113`,889.612`},{632.82`,412.365`},{1028.19`,410.026`},{824.654`,742.227`}};

ShowLabeledGraph[g=Graph[List/@{{1,2},{2,3},{1,3},{1,5},{1,4},{2,5},{2,6},{2,7},{4,10},{10,11},{11,7},{4,9},{9,8},{8,7},{5,6},{6,7},{4,5},{4,12},{12,9},{12,8},{12,11},{8,11},{11,6},{5,10},{10,6},{9,3},{3,8},{9,1},{7,3},{10,12}},List/@v]]

Degrees[g]

RecognizeGraph[g]

{v1,v2}=Vertices[g][[{1,2}]]

g2=ChangeVertices[g,((159(#-v1))/(Norm[v1-v2]))&/@Vertices[g]]

Vertices[g2]

{x,y}/.Solve[{#.#&[v1-{x,y}]==56^2,#.#&[v2-{x,y}]==109^2},{x,y}]

g3=ChangeVertices[g2,{v1={0,0},v2={159,0},v3=159{1/2,(Sqrt[3])/2},v4={44,20 (Sqrt[3])},v5={52,12 (Sqrt[3])},v6=v5+{55,0},v7=v11+{16,0},v8=v9+{16,0},v9={(143/2),((95 (Sqrt[3]))/2)},v10=v4+{16,0},v11=v10+{39,0},v12=v10+39{1/2,(Sqrt[3])/2}}];
IntegralDrawing[g3]

v=Vertices[g3];
FullSimplify[Norm[Subtract@@v[[#]]]&/@Edges[g2]]

ToCommonEdges[g3,"IcosahedralGraph"]

GetGraphData["IcosahedralGraph","File"]

GraphData["IcosahedralGraph","Graph","MinimalPlanarIntegral"]//StyleGraphs

IntegralDrawing/@GraphData["IcosahedralGraph","Graph","MinimalPlanarIntegral"]//StyleGraphs

IntegerCoordinates

GraphData["IcosahedralGraph","Graph","IntegerCoordinates"]//StyleGraphs

Integral

GraphData["IcosahedralGraph","Graph","Integral"]//StyleGraphs

IntegralDrawing/@GraphData["IcosahedralGraph","Graph","Integral"]//StyleGraphs

1

Solve[{x^2+y^2==4^2,7^2==y^2+(9-x)^2},{x,y}]

Solve[{x^2+y^2==7^2,y^2+(7-x)^2==4^2},{x,y}]

Solve[{#.#&[v10-{x,y}]==7^2,x^2+y^2==7^2},{x,y}]

Solve[{#.#&[v3-{x,y}]==7^2,#.#&[v10-{x,y}]==7^2},{x,y}]

Solve[{#.#&[v3-{x,y}]==4^2,#.#&[v5-{x,y}]==9^2},{x,y}]//FullSimplify

Solve[{#.#&[v7-{x,y}]==7^2,#.#&[v4-{x,y}]==4^2},{x,y}]//FullSimplify

Solve[{#.#&[v2-{x,y}]==7^2,#.#&[v7-{x,y}]==4^2},{x,y}]//FullSimplify

Solve[{#.#&[v5-{x,y}]==4^2,#.#&[v11-{x,y}]==7^2},{x,y}]//FullSimplify

Solve[{#.#&[v2-{x,y}]==7^2,#.#&[v12-{x,y}]==7^2},{x,y}]//FullSimplify

Solve[{#.#&[v9-{x,y}]==4^2,#.#&[v2-{x,y}]==9^2},{x,y}]//FullSimplify

ShowLabeledGraph[g1=With[{x=(8/3),y=((4 (Sqrt[5]))/3)},Graph[List/@{{1,2},{2,4},{3,2},{3,1},{1,4},{5,4},{5,1},{4,6},{5,6},{7,5},{7,6},{3,8},{8,2},{9,7},{9,1},{8,10},{10,6},{10,4},{3,9},{5,9},{7,11},{11,3},{9,11},{8,11},{2,10},{11,12},{12,10},{12,6},{7,12},{12,8}},
List/@{v1={0,0},v4={9,0},v7={9/2,9(Sqrt[3])/2},v10={x,y},v3={19/3,-4(Sqrt[5])/3},
v5={(1/6) (27+8 (Sqrt[15])),(11/(2 (Sqrt[3])))},v2={5-2 (Sqrt[(5/3)]),(4/(Sqrt[3]))-2 (Sqrt[5])},v11={(23/3)-2 (Sqrt[(5/3)]),(4/(Sqrt[3]))-((2 (Sqrt[5]))/3)},v12={(19/6)+2 (Sqrt[(5/3)]),(1/6) (19 (Sqrt[3])-4 (Sqrt[5]))},v6={(35/6)+2 (Sqrt[(5/3)]),(1/6) (19 (Sqrt[3])+4 (Sqrt[5]))},v9={-(2/3) (-2+(Sqrt[15])),(2/3) (2 (Sqrt[3])+(Sqrt[5]))},v8={4-2 (Sqrt[(5/3)]),(4/(Sqrt[3]))+2 (Sqrt[5])}}]]]

Simplify[Norm[Subtract@@Vertices[g1][[#]]]]&/@Edges[g1]

Degrees[g1]

RecognizeGraph[g1]

gr1=IntegralDrawing[g1]

2

Solve[{#.#&[v8-{x,y}]==11^2,#.#&[v2-{x,y}]==11^2},{x,y}]//FullSimplify

Solve[{#.#&[v5-{x,y}]==7^2,#.#&[v2-{x,y}]==6^2},{x,y}]//FullSimplify

Solve[{#.#&[v10-{x,y}]==7^2,#.#&[v2-{x,y}]==7^2},{x,y}]//FullSimplify

{x,y}/.Solve[{#.#&[v10-{x,y}]==7^2,#.#&[v5-{x,y}]==7^2},{x,y}]//FullSimplify

{x,y}/.Solve[{#.#&[v7-{x,y}]==6^2,#.#&[v10-{x,y}]==7^2},{x,y}]//FullSimplify

{x,y}/.Solve[{#.#&[v4-{x,y}]==6^2,#.#&[v6-{x,y}]==11^2},{x,y}]//FullSimplify

{x,y}/.Solve[{#.#&[v3-{x,y}]==11^2,#.#&[v6-{x,y}]==11^2},{x,y}]//FullSimplify

{x,y}/.Solve[{#.#&[v9-{x,y}]==6^2,#.#&[v3-{x,y}]==7^2},{x,y}]//FullSimplify

{x,y}/.Solve[{#.#&[v2-{x,y}]==7^2,#.#&[v4-{x,y}]==7^2},{x,y}]//FullSimplify

{x,y}/.Solve[{#.#&[v5-{x,y}]==6^2,#.#&[v1-{x,y}]==7^2},{x,y}]//FullSimplify

ShowLabeledGraph[g2=Graph[List/@{{1,2},{2,3},{3,1},{3,4},{2,4},{2,5},{4,5},{6,4},{6,3},{7,6},{7,4},{7,5},{8,5},{7,8},{9,7},{9,8},{9,6},{10,9},{10,8},{10,1},{11,1},{11,5},{11,2},{11,8},{11,10},{12,1},{12,9},{12,6},{12,10},{3,12}},
List/@{v8={0,0},v2={11,0},v5={(11/2),((11 (Sqrt[3]))/2)},v10={(1/11) (94-6 (Sqrt[30])),(3/11) (9 (Sqrt[3])-2 (Sqrt[10]))},v4={(1/22) (175+12 (Sqrt[30])),(1/22) Root[144648729-29814 ((#1)^2)+((#1)^4)&,4]},v7={-(3/11) (-9+2 (Sqrt[30])),(3/11) (9 (Sqrt[3])+2 (Sqrt[10]))},v6={(1/11) (81-6 (Sqrt[30])),(9/11) (3 (Sqrt[3])+2 (Sqrt[10]))},v3={(11/2)+((12 (Sqrt[30]))/11),((13 (Sqrt[3]))/22)},v9={(1/11) (40-6 (Sqrt[30])),(9/11) (3 (Sqrt[3])-2 (Sqrt[10]))},v1={(67/11),-((12 (Sqrt[10]))/11)},v12={(54/11),((12 (Sqrt[10]))/11)},v11={(1/22) (67+12 (Sqrt[30])),(1/22) (67 (Sqrt[3])-12 (Sqrt[10]))}}]]

Degrees[g2]

FullSimplify[Norm[Subtract@@Vertices[g2][[#]]]]&/@Edges[g2]

RecognizeGraph[g2]

gr2=IntegralDrawing[g2]

All

GraphicsGrid[{{gr1,gr2}},ImageSize->400,Spacings->-40]

e=GraphData["IcosahedralGraph","Embeddings"];

Join[Take[e,11],ToRadicals[ToCommonEdges[#,"IcosahedralGraph"]]&/@{g1,g2},Drop[e,11]]

GetGraphData["IcosahedralGraph","File"]

Line graph

GraphData["IcosahedralGraph","Line"]

LineGraphQ[GraphData["IcosahedralGraph"]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== "IcosahedralGraph"&]

RootGraph[GraphData["IcosahedralGraph"]]

Halin

GraphData["IcosahedralGraph","Halin"]

GraphData["IcosahedralGraph","Graph","Halin"]//StyleGraphs

Rigid

GraphData["IcosahedralGraph","Rigid"]

GraphData["IcosahedralGraph","Graph","Rigid"]//StyleGraphs

Flexible

GraphData["IcosahedralGraph","Flexible"]

GraphData["IcosahedralGraph","Graph","Flexible"]//StyleGraphs

LCF

GraphData["IcosahedralGraph","LCFSignature"]

GraphData["IcosahedralGraph","Graph","LCF"]//StyleGraphs

LCFNotation/@%

Tally[%[[All,-1]]]

LCF compute all

Length[FindHamiltonianCycle[GraphData["IcosahedralGraph"],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData["IcosahedralGraph"],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

Perspective

GraphData["IcosahedralGraph","Graph","Perspective"]//StyleGraphs

UnitDistance

GraphData["IcosahedralGraph","UnitDistance"]

UnitDistanceGraphQ[GraphData["IcosahedralGraph"],Debug->True]//Timing

GraphData["IcosahedralGraph","Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["IcosahedralGraph","VertexList"],GraphData["IcosahedralGraph","EdgeList"]],MaxIterations->500]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]],MaxIterations->500]&/@Complement@@(GraphData["IcosahedralGraph","Graph",#]&/@{"All","UnitDistance"})

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData["IcosahedralGraph"],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData["IcosahedralGraph","Matchstick"]

GraphData["IcosahedralGraph","Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData["IcosahedralGraph","Edges"]]

3D All

GraphData["IcosahedralGraph","Graph",{"3D","All"}]

3D UnitDistance

GraphData["IcosahedralGraph","Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData["IcosahedralGraph","Polyhedral"]

GraphData["IcosahedralGraph","Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData["IcosahedralGraph","Polyhedron"]}]

3D Canonical

GraphData["IcosahedralGraph","Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData["IcosahedralGraph","Polyhedron","Canonical"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["IcosahedralGraph"],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->1000,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

RecognizeGraph@g

Projections

Manipulate[PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

{1, ϵ, ϵ}

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{1,.005,.05},VertexLabels->"Name"]

{0, 0, 1}

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{0,0,1},VertexLabels->"Name"]

{0, 1, 0}

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{0,1,0,π/4+π/20+π/40},VertexLabels->"Name"]

{1, 0, 0}

g=PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{1,-.001,0},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{1,z,0},VertexLabels->"Name"]

v=Lookup[Options[g],VertexCoordinates];

Limit[v,z->0,Direction->"FromBelow"]//FullSimplify

SetProperty[g,VertexCoordinates->%]

{1, 0, -1}

g=PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{1,0,-1},VertexLabels->"Name"]

{3-(Sqrt[5]), 0, -1}

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{3-(Sqrt[5]),0,-1},VertexLabels->"Name"]

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{z,0,-1},VertexLabels->"Name"]

v=Lookup[Options[%],VertexCoordinates];

FullSimplify[SquaredEuclideanDistance@@v[[{7,9}]]-SquaredEuclideanDistance@@v[[{2,4}]],z>0]

Solve[(((5+(Sqrt[5])) (2-2 (Sqrt[5])+z (-8+4 (Sqrt[5])+3 z)))/(40 (1+(z^2))))==0,z]//FullSimplify

N[%]

{(1/3) (-1-(Sqrt[5])), 0, -1}

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{(1/3) (-1-(Sqrt[5])),0,-1},VertexLabels->"Name"]

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{3-(Sqrt[5]),0,-1},VertexLabels->"Name"]

{1, 0, 1}

g=PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{1,0,1},VertexLabels->"Name"]

{XX}

PolyhedronProjectionGraph[PolyhedronData["Icosahedron","Polyhedron"],{1.5,-1.5,.3,-.15},VertexLabels->"Name"]

Stereographic projections

PolyhedronData[g,"Orientations"]

Quiet@GraphPlot[SkeletonGraph[PolyhedronData[{"Icosahedron","C2"},"Faces"]//Normal,#],Method->None]&/@Range[.2,1.5,.1]

GraphPlot[SkeletonGraph[PolyhedronData[{"Icosahedron","C3"},"Faces"]//Normal,#],Method->None]&/@Range[.2,2,.1]

Quiet@GraphPlot[SkeletonGraph[PolyhedronData[{"Icosahedron","C5"},"Faces"]//Normal,#],Method->None]&/@Range[.2,1.5,.1]

Properties

Classes

GraphData[g,"Classes"]

Matrices

GraphicsRow[GraphMatrixPlot[GraphData["IcosahedralGraph"]]]

Properties

TableForm[GraphDataTable[g,x],TableDepth->2]//TraditionalForm

Construction

Embedding 1

ShowLabeledGraph[g=AddEdges[Cycle[6],{{4,2},{2,6},{6,4}}]]

pts=Chop[Mean/@Partition[Vertices[g][[{1,3,5}]],2,1,1]]

ShowLabeledGraph[g2=AddEdges[AddVertices[g,pts],Partition[{3,7,1,9,5,8},2,1,1]]]

pts2=Chop[Mean/@Partition[Vertices[g2][[{7,8,9}]],2,1,1]]

ShowLabeledGraph[g3=AddEdges[AddEdges[AddVertices[g2,pts2],Partition[{7,12,9,11,8,10},2,1,1]],{{10,12},{12,11},{11,10},{10,3},{12,1},{11,5},{2,7},{9,6},{8,4}}]]

FastIsomorphicQ[g3,Graph["IcosahedralGraph"]]

ToCommonEdges[g3,Graph["IcosahedralGraph"]]//PadVertices

Embedding 2

g=GraphicsComplexToGraph[];

FastIsomorphicQ[g,Graph["IcosahedralGraph"]]

ToCommonEdges[g,Graph["IcosahedralGraph"]]//PadVertices

Embedding 3

ShowLabeledGraph[g=ChangeVertices[Cycle[6],Through[{Cos,Sin}[2π (#-1/2)/6]]&/@Range[0,5]],ImageSize->200]

v=Vertices[g];

ShowLabeledGraph[g2=AddEdges[AddVertices[AddEdges[AddVertices[g,
{v[[2]]+(v[[4]]-v[[2]])/3,v[[2]]+(v[[4]]-v[[2]])2/3,
v[[1]]+(v[[5]]-v[[1]])/3,v[[1]]+(v[[5]]-v[[1]])2/3
}],Join[{{3,8},{8,5},{3,7},{7,1},{6,10},{10,4},{6,9},{9,2}},Partition[{2,7,8,4},2,1],Partition[{1,9,10,5},2,1]]],{{0,.25},{0,-.25}}],{{4,11},{11,2},{11,3},{12,5},{12,1},{12,6},{8,12},{12,7},{10,11},{9,11}}],ImageSize->200]

FastIsomorphicQ[g2,Graph["IcosahedralGraph"]]

ToCommonEdges[g2,Graph["IcosahedralGraph"]]//PadVertices

Embedding 4

GraphPlot[(g2=ChangeVertices[g=GraphicsComplexToGraph[],RotationMatrix[-.5].#&/@Vertices[g]]),Method->None]

ToCommonEdges[GraphicsComplexToGraph[],Graph["IcosahedralGraph"]]//PadVertices

distanceregular.org

g=DistanceRegularGraph["http://www.distanceregular.org/graphdata/icosahedron.am"]

RecognizeGraph[g]

VertexCount[g]

GraphDiameter[g]//Timing

RegularParameters[g]//Timing

DistanceRegularGraphQ[g]//Timing

IntersectionArray[g]//Timing

IntegerSpectrum[g]//SpectrumForm

GroupOrder[GraphAutomorphismGroup[g]]

HamiltonianGraphQ[g]

Graceful labelings

GraphData["IcosahedralGraph","Graceful"]

GraphData["IcosahedralGraph","GracefulLabelings"]

lab=%[[2]]

SetProperty[GraphData["IcosahedralGraph"],VertexLabels->Thread[Range[12]->lab]]

GracefullyLabeledGraphQ[%]

Computation

24 fundamentally different solutions

Bert Dobbelaere 2020-10-02:

adj=1+{{1,2,3,4,5},{0,2,5,6,7},{0,1,3,7,8},{0,2,4,8,9},{0,3,5,9,10},{0,1,4,6,10},{1,5,7,10,11},{1,2,6,8,11},{2,3,7,9,11},{3,4,8,10,11},{4,5,6,9,11},{6,7,8,9,10}};

r=RecognizeGraph@(icos=FromAdjacencyLists1[adj])

iso=FindGraphIsomorphism[GraphData[r],icos][[1]]

vorder=Normal[iso][[All,2]]

vlab={0,30,2,29,24,11,7,27,12,3,25,19}[[vorder]]

glab=SetProperty[GraphData[r],VertexLabels->Thread[Range[12]->vlab]]

Length[solns={{30,0,6,1,5,20,28,27,13,24,2,11},{30,0,8,1,16,17,23,27,29,19,28,3},{30,0,9,1,25,11,26,16,29,2,8,4},{30,0,10,1,4,25,27,23,29,18,3,11},{30,0,10,1,13,14,27,25,29,24,21,3},{30,0,10,1,18,25,19,23,2,29,3,5},{30,0,13,1,26,7,22,21,27,29,2,11},{30,0,16,1,3,6,26,25,29,24,14,7},{30,0,17,1,25,23,26,8,28,29,4,14},{30,0,17,1,26,8,23,12,3,29,2,22},{30,0,18,1,9,23,26,24,28,29,4,13},{30,0,19,1,4,24,9,23,2,29,17,7},{30,0,21,1,11,24,25,7,29,13,28,2},{30,0,25,1,8,12,28,27,4,21,2,13},{30,0,25,1,29,7,21,8,28,13,11,2},{30,0,26,1,8,2,13,23,6,20,29,5},{30,0,27,1,7,11,28,20,6,16,29,4},{30,0,27,1,23,5,28,8,18,2,17,4},{30,0,28,1,6,19,23,3,18,27,5,11},{30,0,1,4,13,20,16,28,22,27,5,3},{30,0,1,4,25,2,22,16,28,21,11,3},{30,0,1,6,2,20,9,26,14,29,23,7},{30,0,1,12,4,16,9,28,22,7,29,5},{30,0,1,19,2,25,13,27,11,26,4,7}}]

GracefullyLabeledGraphQ/@And@@(SetProperty[GraphData["IcosahedralGraph"],VertexLabels->Thread[Range[12]->#[[vorder]]]]&/@solns)

lab=(MapIndexed[(#2[[1]]->Placed[#,Center])&,solns[[1]]])

SetProperty[GraphData["IcosahedralGraph"],{VertexLabels->lab[[vorder]],VertexSize-> .75}]

GraphicsGrid[Partition[Function[soln,SetProperty[GraphData["IcosahedralGraph"],{VertexStyle->LightGray,VertexLabels->(MapIndexed[(#2[[1]]->Placed[#,Center])&,soln[[vorder]]]),VertexSize-> .8}]]/@solns,5],ImageSize->1000]

Canonicalize:

fundorig=#[[{1,12,4,7,2,6,9,10,3,5,8,11}]]&/@{{30,0,6,1,5,20,28,27,13,24,2,11},{30,0,8,1,16,17,23,27,29,19,28,3},{30,0,9,1,25,11,26,16,29,2,8,4},{30,0,10,1,4,25,27,23,29,18,3,11},{30,0,10,1,13,14,27,25,29,24,21,3},{30,0,10,1,18,25,19,23,2,29,3,5},{30,0,13,1,26,7,22,21,27,29,2,11},{30,0,16,1,3,6,26,25,29,24,14,7},{30,0,17,1,25,23,26,8,28,29,4,14},{30,0,17,1,26,8,23,12,3,29,2,22},{30,0,18,1,9,23,26,24,28,29,4,13},{30,0,19,1,4,24,9,23,2,29,17,7},{30,0,21,1,11,24,25,7,29,13,28,2},{30,0,25,1,8,12,28,27,4,21,2,13},{30,0,25,1,29,7,21,8,28,13,11,2},{30,0,26,1,8,2,13,23,6,20,29,5},{30,0,27,1,7,11,28,20,6,16,29,4},{30,0,27,1,23,5,28,8,18,2,17,4},{30,0,28,1,6,19,23,3,18,27,5,11},{30,0,1,4,13,20,16,28,22,27,5,3},{30,0,1,4,25,2,22,16,28,21,11,3},{30,0,1,6,2,20,9,26,14,29,23,7},{30,0,1,12,4,16,9,28,22,7,29,5},{30,0,1,19,2,25,13,27,11,26,4,7}};

Function[lab,GracefullyLabeledGraphQ[SetProperty[GraphData["IcosahedralGraph"],VertexLabels->MapIndexed[#2[[1]]->#&,lab]]]]/@fundorig

GraphData["IcosahedralGraph","GracefulLabelings","Count"]

Length[all=GracefulLabelingsExpand[GraphData["IcosahedralGraph"],fundorig]]//Timing

fund=GracefulLabelingsReduce[GraphData["IcosahedralGraph"],all]

Length[fund]

And@@Function[lab,GracefullyLabeledGraphQ[SetProperty[GraphData["IcosahedralGraph"],VertexLabels->MapIndexed[#2[[1]]->#&,lab]]]]/@fund

GraphData

GraphClassString

GraphClassString[g]