Small Rhombicuboctahedral Graph

Author

Eric W. Weisstein
August 7, 2023

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

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

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

Embeddings

<<MathWorld`Graphs`

Names

GraphData["SmallRhombicuboctahedralGraph","StandardName"]

GraphData["SmallRhombicuboctahedralGraph","StandardNames"]

Primary

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

Construction from Read and Wilson

All

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

Inexact

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

Embeddings

GraphDataEmbeddings[GraphData["SmallRhombicuboctahedralGraph","EdgeList"]]

Planar

GraphData["SmallRhombicuboctahedralGraph","Planar"]

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

Tutte embeddings

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

Tally[ReverseSort[Length/@faces]]

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

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

Tutte embedding construction 4 #1

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

RecognizeGraph[g]

Tutte embedding construction 4 #2

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

RecognizeGraph[g]

Tutte embedding construction 3

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

RecognizeGraph[g]

MinimalCrossing

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

Degenerate

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

LCF

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

LCF compute all

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

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//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]

(gs=Flatten[{
(* all LCF's with order >2, 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|2}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1|2}]]}])//Timing

Length[gs]

Perspective

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

UnitDistance

GraphData["SmallRhombicuboctahedralGraph","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Close-to-unit distance (6-fold symmetry)

PolyhedronData["SmallRhombicuboctahedron","V"]

Length[v]

c=CirclePoints[(1/(Sqrt[3])),6];

v=Join[c,{v[[3]]+{1,0},v[[1]]+{1,0},v[[6]]-{1,0},v[[4]]-{1,0}},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6]])&/@{3,5},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6+π]])&/@{2,6},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6-π/3]])&/@{2,4},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6-π/3+π]])&/@{1,5},
Table[RotationMatrix[2Pi n/6].{(2/(3 (Sqrt[3]))),0},{n,0,5}]
];
g=Graph[Range[Length[v]],UndirectedEdge@@@{{1,3},{3,5},{1,5},{2,4},{4,6},{2,6},{3,7},{8,7},{1,8},{4,10},{9,10},{6,9},{5,12},{11,12},{3,11},{6,14},{13,14},{2,13},{4,16},{15,16},{2,15},{1,17},{17,18},{5,18},{11,20},{16,20},{15,20},{7,20},{15,19},{7,19},{8,19},{13,19},{8,24},{13,24},{14,24},{17,24},{14,23},{17,23},{18,23},{9,23},{18,22},{9,22},{10,22},{12,22},{10,21},{12,21},{11,21},{16,21}},VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

EdgeLengths[g]//FullSimplify//Tally

%[[All,1]]//N

eqn=FullSimplify[Equal@@SquaredEuclideanDistance[v[[#]],{x,y}]&/@{11,16,15,7},x>0&&y>0]

Solve[eqn,{x,y}]

RegionIntersection[Line[v[[{1,3}]]],Line[v[[{2,4}]]]][[1,1]]

Mean[{{(1/(2 (Sqrt[3]))),(1/6)},{(1/(2 (Sqrt[3]))),-(1/6)},v[[2]]}]

GraphPlot[]

v=c;

v[[15,1]]

v=Join[c,{v[[3]]+{1,0},v[[1]]+{1,0},v[[6]]-{1,0},v[[4]]-{1,0}},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6]])&/@{3,5},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6+π]])&/@{2,6},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6-π/3]])&/@{2,4},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6-π/3+π]])&/@{1,5},
Table[RotationMatrix[2Pi n/6].{(1/2)+(1/(Sqrt[3])),0},{n,0,5}]
];
g=Graph[Range[Length[v]],UndirectedEdge@@@{{1,3},{3,5},{1,5},{2,4},{4,6},{2,6},{3,7},{8,7},{1,8},{4,10},{9,10},{6,9},{5,12},{11,12},{3,11},{6,14},{13,14},{2,13},{4,16},{15,16},{2,15},{1,17},{17,18},{5,18},{11,20},{16,20},{15,20},{7,20},{15,19},{7,19},{8,19},{13,19},{8,24},{13,24},{14,24},{17,24},{14,23},{17,23},{18,23},{9,23},{18,22},{9,22},{10,22},{12,22},{10,21},{12,21},{11,21},{16,21}},VertexCoordinates->v,VertexLabels->"Name"]

v=Join[c,{v[[3]]+{1,0},v[[1]]+{1,0},v[[6]]-{1,0},v[[4]]-{1,0}},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6]])&/@{3,5},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6+π]])&/@{2,6},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6-π/3]])&/@{2,4},
(v[[#]]+Through[{Cos,Sin}[π/2+π/6-π/3+π]])&/@{1,5},
Table[RotationMatrix[2Pi n/6].{5/2,0},{n,0,5}]
];
g=Graph[Range[Length[v]],UndirectedEdge@@@{{1,3},{3,5},{1,5},{2,4},{4,6},{2,6},{3,7},{8,7},{1,8},{4,10},{9,10},{6,9},{5,12},{11,12},{3,11},{6,14},{13,14},{2,13},{4,16},{15,16},{2,15},{1,17},{17,18},{5,18},{11,20},{16,20},{15,20},{7,20},{15,19},{7,19},{8,19},{13,19},{8,24},{13,24},{14,24},{17,24},{14,23},{17,23},{18,23},{9,23},{18,22},{9,22},{10,22},{12,22},{10,21},{12,21},{11,21},{16,21}},VertexCoordinates->v,VertexLabels->"Name"]

gs={,}

Matchstick

GraphData["SmallRhombicuboctahedralGraph","Matchstick"]

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

3D default

Graph3D[GraphData["SmallRhombicuboctahedralGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["SmallRhombicuboctahedralGraph","Polyhedral"]

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

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

3D Canonical

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

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

Projections

PolyhedronProjectionGraph[PolyhedronData["SmallRhombicuboctahedron","Polyhedron"],#,"Simplification"->FullSimplify]&/@{{0,0,1},{1,0,1},{1,1,2-(Sqrt[2]),-ArcTan[(NumericalApproximation[Root, (RowDefault["-0.383", FEExpressionsNumericalApproximationElider]), Root[1-8 ((#1)^2)+8 ((#1)^4)&,2], ])]},{-5+4 (Sqrt[2]),1,0},{(3/2)-(1/(Sqrt[2])),(3/2)-(1/(Sqrt[2])),1,ArcTan[(Sqrt[(2/97) (13+6 (Sqrt[2]))])]},{1,1,(Sqrt[2]),ArcCot[(Sqrt[2])]},{1,1,1}}

GraphData["SmallRhombicuboctahedralGraph","Graph","Perspective"]