Rhombic Dodecahedral Graph

Author

Eric W. Weisstein
August 25, 2022

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

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

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

Embeddings

GraphData["RhombicDodecahedralGraph","StandardName"]

Primary

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

Default embedding

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

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

RecognizeGraph[g]

All

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

Embedding Types

GraphDataEmbeddings[GraphData["RhombicDodecahedralGraph","EdgeList"]]

Incidence

GetGraphData["RhombicDodecahedralGraph","File"]

GraphData["RhombicDodecahedralGraph","Incidence"]

Select[GraphData[All],GraphData[#,"LeviGraph","Name"]==="RhombicDodecahedralGraph"&]

Levi graph of Miquel configuration

lines=GraphData["RhombicDodecahedralGraph","IncidenceLines"]

ConfigurationNotation[lines]

levi=LeviGraph[lines]

RecognizeGraph@levi

Planar

GraphData["RhombicDodecahedralGraph","Planar"]

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

Tutte embeddings

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

Tally[ReverseSort[Length/@faces]]

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

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

Tutte embedding construction

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

RecognizeGraph[g]

MinimalCrossing

GraphData["RhombicDodecahedralGraph",{"RCN","CN"}]

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

MinimalCrossing construction

RotateGraph[MinimalCrossingGraph[GraphData["RhombicDodecahedralGraph"],"CrossingNumber"->-1]]

RecognizeGraph[g]

Degenerate

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

Circulant

GraphData["RhombicDodecahedralGraph","Graph","Circulant"]//StyleGraphs

Halin

GraphData["RhombicDodecahedralGraph","Halin"]

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

LCF

GraphData["RhombicDodecahedralGraph","LCF"]

GraphData["RhombicDodecahedralGraph","LCFSignature"]

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

UnitDistance

GraphData["RhombicDodecahedralGraph","UnitDistance"]

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

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

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

Select[UnitDistanceEmbeddingRefine/@Complement@@(GraphData["RhombicDodecahedralGraph","Graph",#]&/@{"All","UnitDistance"}),UnitDistanceGraphEmbeddingQ]

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

UnitDistance exact construction

v0={{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}};

edges=UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,6},{2,4},{2,7},{3,4},{3,8},{4,9},{4,10},{5,7},{5,11},{6,8},{6,11},{7,9},{7,12},{8,10},{8,13},{9,14},{10,14},{11,12},{11,13},{12,14},{13,14}};

Manipulate[
solns=NSolve[Join[eqn,{z==z0,h==h0}],{h,x,z,a,b,c,d},Reals];
Graph[Range[14],edges,VertexCoordinates->({{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}}/.#),VertexLabels->"Name"]&/@solns,
{{z0,.5},0,2},{{h0,.88},0,2}]

eqn=UnitEdgeEquations[v0,edges]

perpeqns=RightAngleEquation[v0,#]&/@{{11,13,14},{12,11,13}}//Simplify

solns=Solve[Join[eqn,perp,{z==1/2}],{h,x,z,a,b,c,d},Reals]//FullSimplify

gs=Graph[Range[14],edges,VertexCoordinates->(v0/.#)]&/@solns

gs=Take[%,2]

g=

g//UnitDistanceGraphEmbeddingQ

v=GraphEmbedding[g];

v[[{4,11}]]

q=ArcTan@@-Subtract@@v[[{7,8}]]

vnew=RotationMatrix[q].#&/@((#-Mean[v])&/@v)

g2=SetProperty[g,VertexCoordinates->vnew]

g2=

UnitDistanceGraphEmbeddingQ[g2]

EdgeLengths[g2]

v2=GraphEmbedding[g2]

eqn={
c^2+(h-d)^2==1,
a^2+(b-h)^2==1,
a^2+(b-z)^2==1,
c^2+(d+z)^2==1,
(c-x)^2+d^2==1,
(a-x)^2+b^2==1,
(x-c)^2+d^2==1};

soln={a->v2[[6,1]],b->v2[[6,2]],c->v2[[13,1]],d->v2[[13,2]],h->v2[[11,2]],x->v2[[8,1]],z->v2[[1,2]]}

eqn[[All,1]]/.soln

g=Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,6},{2,4},{2,7},{3,4},{3,8},{4,9},{4,10},{5,7},{5,11},{6,8},{6,11},{7,9},{7,12},{8,10},{8,13},{9,14},{10,14},{11,12},{11,13},{12,14},{13,14}},VertexCoordinates->({{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}}/.soln),VertexLabels->"Name"]

RecognizeGraph[g]

solns=NSolve[Join[eqn,{z==0.33856347376065954`,h==1.3695344333549617`}],{h,x,z,a,b,c,d},Reals]

g=Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,6},{2,4},{2,7},{3,4},{3,8},{4,9},{4,10},{5,7},{5,11},{6,8},{6,11},{7,9},{7,12},{8,10},{8,13},{9,14},{10,14},{11,12},{11,13},{12,14},{13,14}},VertexCoordinates->({{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}}/.#),VertexLabels->"Name"]&/@solns

Manipulate[
solns=NSolve[Join[eqn,{z==z0,h==h0}],{h,x,z,a,b,c,d},Reals];
Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,6},{2,4},{2,7},{3,4},{3,8},{4,9},{4,10},{5,7},{5,11},{6,8},{6,11},{7,9},{7,12},{8,10},{8,13},{9,14},{10,14},{11,12},{11,13},{12,14},{13,14}},VertexCoordinates->({{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}}/.#),VertexLabels->"Name"]&/@solns,
{{z0,0.33856347376065954},0,2},{{h0,1.3695344333549617},0,2}]

solns=Solve[Join[eqn,{z==1/3,h==137/100}],{h,x,z,a,b,c,d},Reals];
gs=Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,6},{2,4},{2,7},{3,4},{3,8},{4,9},{4,10},{5,7},{5,11},{6,8},{6,11},{7,9},{7,12},{8,10},{8,13},{9,14},{10,14},{11,12},{11,13},{12,14},{13,14}},VertexCoordinates->({{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}}/.#),VertexLabels->"Name"]&/@solns

solns=NSolve[Join[eqn,{x^2==h^2==a^2+b^2}],{h,x,z,a,b,c,d},Reals];
gs=Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,6},{2,4},{2,7},{3,4},{3,8},{4,9},{4,10},{5,7},{5,11},{6,8},{6,11},{7,9},{7,12},{8,10},{8,13},{9,14},{10,14},{11,12},{11,13},{12,14},{13,14}},VertexCoordinates->({{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}}/.#),VertexLabels->"Name"]&/@solns

UnitDistance exact construction with squares

Clear[h,x,z,a,b,c,d]

eqn={
c^2+(h-d)^2==1,
a^2+(b-h)^2==1,
a^2+(b-z)^2==1,
c^2+(d+z)^2==1,
(c-x)^2+d^2==1,
(a-x)^2+b^2==1,
(x-c)^2+d^2==1};

perp={
Dot[{c,-d-z}.{a,b-z}]==0,
Dot[{x-a,-b}.{a,b-z}]==0,
Dot[{c,d+z}.{x-c,-d}]==0,
Dot[{a,b-z}.{c,d-h}]==0
}

radius={a^2+b^2==h^2}

soln=Solve[Join[eqn,perp,radius],{h,x,z,a,b,c,d},Reals]//FullSimplify

gs=Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,6},{2,4},{2,7},{3,4},{3,8},{4,9},{4,10},{5,7},{5,11},{6,8},{6,11},{7,9},{7,12},{8,10},{8,13},{9,14},{10,14},{11,12},{11,13},{12,14},{13,14}},VertexCoordinates->({{0,z},{-c,-d},{c,-d},{0,-h},{-a,b},{a,b},{-x,0},{x,0},{-a,-b},{a,-b},{0,h},{-c,d},{c,d},{0,-z}}/.#),VertexLabels->"Name"]&/@soln

RecognizeGraph/@gs

g2=;

Equal@@Norm/@GraphEmbedding[g2][[{4,9,7}]]//FullSimplify

EdgeLengths[g2]//FullSimplify//Union

UnitDistance FindSubgraphUnitDistanceEmbedding

{"RhombicDodecahedralGraph",l=FindSubgraphUnitDistanceEmbedding[GraphData["RhombicDodecahedralGraph"],TimeConstraint->300,"Results"->All]//Timing}

gs=UniqueEmbeddings[l]

Matchstick

GraphData["RhombicDodecahedralGraph","Matchstick"]

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

3D default

Graph3D[GraphData["RhombicDodecahedralGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["RhombicDodecahedralGraph","Polyhedral"]

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

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

3D Canonical

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

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

3D Canonical construction

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

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

SimplePolyhedronQ[can]

If[%===False,Quit[]]

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]

2-vertex deletion of TesseractGraph -> RhombicDodecahedralGraph

VertexDelete[GraphData["TesseractGraph","Graph",{"Labeled","UnitDistance"}][[1]],{8,14}]

RecognizeGraph[%]

Properties

Classes

GraphData[g,"Classes"]

Matrices

GraphicsRow[GraphMatrixPlot[GraphData["RhombicDodecahedralGraph"]]]

Properties

GraphData[g,"Missing"]

GraphData[g,{"V","M"}]

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

PolyhedralEmbeddings

GraphData["RhombicDodecahedralGraph","PolyhedralEmbeddings"]

Projections

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

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

{0,Sqrt[2],1}

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

{2 (Sqrt[2]),(Sqrt[2]),3,ArcCot[(5/(Sqrt[19]))]}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{2 (Sqrt[2]),(Sqrt[2]),3,ArcCot[(5/(Sqrt[19]))]},VertexLabels->"Name"]

v=GraphEmbedding[g]

ArcTan@@(v[[3]]-v[[6]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{.81,.4,.87},VertexLabels->"Name"]

{.81,.4,.87}/.87

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{x,y,1},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[CollinearPoints[v[[{3,8,1}]]],x>0&&y>0]

FullSimplify[SquaredEuclideanDistance@@v[[{3,8}]]-SquaredEuclideanDistance@@v[[{1,8}]],x>0&&y>0]

Solve[{(Sqrt[2]) (x+y)==2,-1+((1+4 (Sqrt[2]) y+2 x ((Sqrt[2])-x+2 y))/(3 (1+(x^2)+(y^2))))==0},{x,y}]//FullSimplify

{2 (Sqrt[2]),(Sqrt[2]),1,ArcTan[(Sqrt[11])]}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{2 (Sqrt[2]),(Sqrt[2]),1,ArcTan[(Sqrt[11])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[3]]-v[[10]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{.8,.4,.3},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{x,y,1},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[Thread[v[[14]]==v[[2]]],x>0&&y>0]

Solve[%,{x,y}]

{1,-1,((Sqrt[2])/3),-ArcCot[(Sqrt[10])]}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{1,-1,((Sqrt[2])/3),-ArcCot[(Sqrt[10])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[13]]-v[[6]])//FullSimplify

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

v=GraphEmbedding[g];

FullSimplify[CollinearPoints[v[[{6,4,13}]]],z>0]

Solve[%,z]

{0, 0, 1}

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

{1, 1, 1, π/6}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{1,1,1,π/6},"Simplification"->FullSimplify,VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[11]]-v[[4]])//FullSimplify

{0, 1, 0}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicDodecahedron","Polyhedron"],{0,1,0,π/2},VertexLabels->"Name"]

{1, 0, 1}

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

Sterographic projection

PolyhedronData[poly]

Degenerate

GraphPlot[SkeletonGraph[PolyhedronData[poly,"Faces"]//Normal,#],Method->None]&/@{1.9,2.7,3,3.5,5,6}

r=RecognizeGraph[g=ToCombinatoricaGraph[]]

ToCommonEdges[g,r]

Embeddings

Fruchard Graph

http://czamfirescu.tricube.de/CTZamfirescu-17.pdf

http://czamfirescu.tricube.de/CTZamfirescu-28.pdf

e[l__]:=Sequence@@Partition[{l},2,1]

g=Graph[Range[14],Sort[Sort/@UndirectedEdge@@@{e[1,2,3,14,1,6,11,12,13,8,3],e[6,4,2,5,8],e[11,14,13],e[4,7,10],e[5,7,9],e[6,9,12,10,8]}],VertexCoordinates->{{-3,0},{0,0},{3,0},{-1/2,1/2},{1/2,1/2},{-1,1},{0,1},{1,1},{-1/2,3/2},{1/2,3/2},{-1,2},{0,2},{1,2},{0,4}},VertexLabels->Automatic]

<<MathWorld`Graphs`

RecognizeGraph[g]

GraphData["RhombicDodecahedralGraph","V"]

GraphData["RhombicDodecahedralGraph","Bipartite"]

GraphData["RhombicDodecahedralGraph","Traceable"]

GraphData["RhombicDodecahedralGraph","Polyhedral"]

GetGraphData["RhombicDodecahedralGraph","File"]

GraphData

GraphClasses

GraphClassString[g]