Rolling Polyhedron Graph

Author

Eric W. Weisstein
November 10, 2023

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

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

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

Additional Authors

Construction and comments from
Ed Pegg, Jr.
2005, 2018, and 2019

Graphic

<<MathWorld`Graphs`

TextGrid[rolling=SortBy[DeleteCases[Function[g,{g,GraphData[g,"Name"],SelectFirst[Cases[GraphData[g,"Names"],_String],StringMatchQ[#,"rolling*"]&]}]/@GraphData[All],{_,_,_Missing}],GraphData[#[[1]],"V"]&],Dividers->All]

TextGrid[GraphData[#,{"V","#","|HC|"}]&/@rolling[[All,1]],Dividers->All,Alignment->{{Decimal,Left,Decimal}}]

GraphicsGrid[Partition[Show[StyleGraphs[GraphData[#],VertexSize->Scaled[.025]],PlotLabel->TextCell[If[#2===#3,#2,Column[{#3,Row[{"["<>#2<>"]"}]},Alignment->Center]],PageWidth->160,TextAlignment->Center],LabelStyle->Directive[Black,Italic,FontFamily->"Times"]]&@@@rolling,UpTo[4]],ImageSize->700,Dividers->All,Alignment->Center]

General

From Ed Pegg, Jr. Oct 25, 2018:

Rolling graphs could be made from any polyhedron with a finite number of orientations produced by rolling.
Polyhedra with triangles and pentagons have a parity issue, since a roll produces a mirror image orientation.
Polyhedra with different polygon types also have a parity issue based on the topmost polygon type.

From Ed Pegg, Jr. Nov 2, 2018:

I thought solving the icosahedron would give me insight for solving the others, but unfortunately I got lucky with the icosahedron.
All the 8 http://mathworld.wolfram.com/Deltahedron.html  will definitely have some graph, but I don't know if they have closed loops.
Similarly, the Archimedeans will have graphs, but I don't know which are possible without juxtaposed cells, and if any have closed loops.
For a general polyhedron, the sum of the angles around each vertex has to be rational multiple of 2Pi, or else rolling about that vertex will give infinite orientations.  A tetrahedron of 4-5-6 triangles has vertex sums of Pi. That likely isn't a sufficient condition.

"RollingCubeGraph"

Defnition

Originally suggested by Ed Pegg, Jr. around 2005

Description from Ed Pegg, Jr. Oct 25, 2018

A cube has 24 orientations. Those are the 24 vertices.  If a cube is rolled on an edge a new orientation results.  These are the edges of the graph.

 The outer circle of GraphData["RollingCubeGraph"]  is a Hamiltonian circuit corresponding to cube rolling around inside the perimeter of a 2x4 rectangle 3 times. This gives all 24 orientations of the cube.

Some related items are the following.

http://demonstrations.wolfram.com/RollingACubeOnAChessboard/
http://demonstrations.wolfram.com/RegularTetrahedonRollingOnAPlane/

The cube is the only polyhedron that can roll without parity issues.

Construction

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

As a rolling cube

From Ed Pegg, Oct 25, 2018

First we need the octahedral rotation group in a convenient form.

tup=GatherBy[SortBy[Tuples[Range[-1,2],{3}],{Sort[Abs[#]], Abs[#]}&],RollPitchYawMatrix[# Pi/2]&][[All,1]]

Elements 2 to 5 correspond to edge rolls with the RollPitchYawMatrix[].

orientations={{-1,0,0},{0,-1,0},{0,0,-1},{0,0,1},{0,1,0},{1,0,0}}.RollPitchYawMatrix[# Pi/2]&/@tup;

From there we can generate edges.

edges=Union[Sort/@Flatten[Table[{k,Position[orientations,orientations[[k]].RollPitchYawMatrix[tup[[n]] Pi/2]][[1,1]]},{n,2,5}, {k,24}],1]]

g=System`Graph[UndirectedEdge@@@edges]

RecognizeGraph@g

As a bipartite double

GraphData["CuboctahedralGraph"]

RecognizeGraph[BipartiteDoubleGraph[GraphData["CuboctahedralGraph"]]]

Embeddings

Names

GraphData["RollingCubeGraph","StandardName"]

GraphData["RollingCubeGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["RollingCubeGraph","EdgeList"]]

Default embedding

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

e[l__]:=Sequence@@Partition[{l},2,1]
v=Join@@Table[RotationMatrix[i Pi/2].#&/@Join[Table[{i,0},{i,1/2,1,1/6}],{{1,1},{1,1}/2}],{i,0,3}];
ee=Sort[Sort/@{e[4,5,10,11,16,17,22,23,4],e[3,8,15,19,3],e[5,9,11,15,17,21,23,3,5],e[18,8,24,14,6,20,12,2,18],e[10,1,22,13,10],e[19,12,1,18,7,24,13,6,19]}];
g=Graph[Range[Length[v]],UndirectedEdge@@@ee,VertexCoordinates->v,VertexLabels->Automatic]

g=;

RecognizeGraph[g]

Degenerate

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

Circular

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

Bilateral

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

Planar

GraphData["RollingCubeGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData["RollingCubeGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["RollingCubeGraph"],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["RollingCubeGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["RollingCubeGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,1000}],Max[OuterFace[#]]<=GraphData["RollingCubeGraph","V"]&]]//Timing

GraphPlot@RotateGraph[,Pi/4,VertexSize->.5]

Table[MinimalCrossingGraph[GraphData["RollingCubeGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,500}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

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

Halin

GraphData["RollingCubeGraph","Halin"]

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

LCF

GraphData["RollingCubeGraph","LCF"]

GraphData["RollingCubeGraph","LCFSignature"]

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

LCF compute all

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

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

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]

UnitDistance

GraphData["RollingCubeGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine/@GraphData["RollingCubeGraph","Graph","All"]

Select[%,UnitDistanceGraphEmbeddingQ]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData["RollingCubeGraph"],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

FindUnitDistanceEmbedding[GraphData["RollingCubeGraph"],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

GraphData["RollingCubeGraph","Matchstick"]

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

3D default

Graph3D[GraphData["RollingCubeGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["RollingCubeGraph","Polyhedral"]

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

"RollingGyroelongatedSquareDipyramidGraph"

Construction

From Ed Pegg Jr. Nov 22-23, 2019

RollingGyroelongatedSquareDipyramidGraph={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{36,37},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45},{45,46},{46,47},{47,48},{48,49},{49,50},{50,51},{51,52},{52,53},{53,54},{54,55},{55,56},{56,57},{57,58},{58,59},{59,60},{60,61},{61,62},{62,63},{63,64},{64,65},{65,66},{66,67},{67,68},{68,69},{69,70},{70,71},{71,72},{72,73},{73,74},{74,75},{75,76},{76,77},{77,78},{78,79},{79,80},{80,81},{81,82},{82,83},{83,84},{84,85},{85,86},{86,87},{87,88},{88,89},{89,90},{90,91},{91,92},{92,93},{93,94},{94,95},{95,96},{2,19},{6,23},{10,27},{14,31},{18,35},{22,39},{26,43},{30,47},{34,51},{38,55},{42,59},{46,63},{50,67},{54,71},{58,75},{62,79},{66,83},{70,87},{74,91},{78,95},{4,29},{8,33},{12,37},{16,41},{20,45},{24,49},{28,53},{32,57},{36,61},{40,65},{44,69},{48,73},{52,77},{56,81},{60,85},{64,89},{68,93},{1,72},{5,76},{9,80},{13,84},{17,88},{21,92},{25,96},{3,82},{7,86},{11,90},{15,94},{1,96}};

g1=Graph[Range[96],UndirectedEdge@@@RollingGyroelongatedSquareDipyramidGraph,VertexCoordinates->CirclePoints[96]]

Embeddings

GraphData["RollingGyroelongatedSquareDipyramidGraph","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["RollingGyroelongatedSquareDipyramidGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Bilateral

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

Circular

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

Circulant

GraphData["RollingGyroelongatedSquareDipyramidGraph","Circulant"]

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

GeneralizedPetersen

GraphData["RollingGyroelongatedSquareDipyramidGraph","GeneralizedPetersen"]

GraphData["RollingGyroelongatedSquareDipyramidGraph","Graph","GeneralizedPetersen"]//StyleGraphs

Halin

GraphData["RollingGyroelongatedSquareDipyramidGraph","Halin"]

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

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData["RollingGyroelongatedSquareDipyramidGraph"],TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData["RollingGyroelongatedSquareDipyramidGraph"],TimeConstraint->60])//AbsoluteTiming

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["RollingGyroelongatedSquareDipyramidGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["RollingGyroelongatedSquareDipyramidGraph","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["RollingGyroelongatedSquareDipyramidGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["RollingGyroelongatedSquareDipyramidGraph"],"CrossingNumber"->81]]

LCF

GraphData["RollingGyroelongatedSquareDipyramidGraph","HamiltonianCycleCount"]

GraphData["RollingGyroelongatedSquareDipyramidGraph","LCFNotations"]

GraphData["RollingGyroelongatedSquareDipyramidGraph","LCFSignature"]

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

LCF compute

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

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

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName["RollingGyroelongatedSquareDipyramidGraph",".m.gz"]])[[All,2]]]//Timing

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[{BilateralLCFEmbedding[#],#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1|2}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFEmbedding/@LCFGraph@@@Cases[lcf,{_,2}]]}]

Length[gs]

UnitDistance

GraphData["RollingGyroelongatedSquareDipyramidGraph","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

GraphData["RollingGyroelongatedSquareDipyramidGraph","Matchstick"]

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

3D default

Graph3D[GraphData["RollingGyroelongatedSquareDipyramidGraph","Edges"]]

3D All

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

3D UnitDistance

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

"RollingIcosahedronGraph" == "Foster120B"

From Ed Pegg. Jr.
November 2, 2018

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

GraphData["RollingIcosahedronGraph","#"]

Construction

GraphData["Foster120B","LCFSignature"]

GraphData["Foster120B","Graph","All"]

Orientations

The 120 orientations of a rolling icosahedron. The first number is the top face (1-20) and the second is the Pi/3 orientation of that face (1-6).

d20=Flatten[Table[{
{{#[[1]],k},{ #[[2]],k}},
{{#[[1]],k},{ #[[3]],If[#[[1]]>10,If[OddQ[#[[1]]],Mod[k+1,6,1],Mod[k-1,6,1]],Mod[k,6,1]]}},
{{#[[1]],k},{ #[[4]],If[#[[1]]>10,If[OddQ[#[[1]]],Mod[k-1,6,1],Mod[k+1,6,1]],Mod[k,6,1]]}}
},{k,1,6}]&/@Join[Transpose[{Range[10],RotateLeft[Range[10]],RotateRight[Range[10]], Range[10]+10}],Transpose[{Range[11,20],Range[10],RotateLeft[Range[11,20],2], RotateRight[Range[11,20],2]}]],1];

d20e=Union[Sort/@Flatten[d20,1]];

Order 15 mirror symmetry with this path.

pont={{-((Sqrt[3])/2),-(3/2)},{((Sqrt[3])/2),-(3/2)},{0,-1},{-(Sqrt[3]),-1},{-((Sqrt[3])/2),-(1/2)},{((Sqrt[3])/2),-(1/2)},{0,0},{-(Sqrt[3]),0},{(Sqrt[3]),0},{-((Sqrt[3])/2),(1/2)},{((Sqrt[3])/2),(1/2)},{0,1},{(Sqrt[3]),-1},{-((Sqrt[3])/2),(3/2)},{((Sqrt[3])/2),(3/2)},{0,2}};

lin=Select[Subsets[pont,{2}],EuclideanDistance@@#==1&];

path={{((Sqrt[3])/4),-(1/4)},{((Sqrt[3])/4),(1/4)},{((Sqrt[3])/4),(3/4)},{((Sqrt[3])/4),(5/4)},{0,(3/2)},{-((Sqrt[3])/4),(5/4)},{-((Sqrt[3])/4),(3/4)},{-((Sqrt[3])/4),(1/4)},{-((Sqrt[3])/4),-(1/4)},{0,-(1/2)},{((Sqrt[3])/4),-(3/4)},{((Sqrt[3])/2),-1},{((3 (Sqrt[3]))/4),-(3/4)},{((3 (Sqrt[3]))/4),-(1/4)},{((Sqrt[3])/2),0},{((Sqrt[3])/4),(1/4)},{0,(1/2)},{-((Sqrt[3])/4),(1/4)},{-((Sqrt[3])/2),0},{-((3 (Sqrt[3]))/4),-(1/4)},{-((3 (Sqrt[3]))/4),-(3/4)},{-((Sqrt[3])/2),-1},{-((Sqrt[3])/4),-(3/4)},{0,-(1/2)}};

graphic1={Graphics[{Disk[#,.03]&/@pont, Line/@lin,Green,BSplineCurve[path,SplineClosed->True]}],With[{base={{1,1},{11,1},{13,2},{3,2},{2,2},{1,2},{10,2},{9,2},{19,2},{17,1},{15,6},{13,5},{11,4},{19,3},{9,3},{8,3},{7,3},{6,3},{5,3},{15,3},{17,4},{7,4},{8,4},{18,4},{16,5},{14,6},{4,6},{5,6},{6,6},{16,6},{18,5},{20,4},{12,3},{2,3},{3,3},{4,3},{14,3},{12,4},{20,5},{10,5},{1,5},{11,5},{13,6},{3,6},{2,6},{1,6},{10,6},{9,6},{19,6},{17,5},{15,4},{13,3},{11,2},{19,1},{9,1},{8,1},{7,1},{6,1},{5,1},{15,1},{17,2},{7,2},{8,2},{18,2},{16,3},{14,4},{4,4},{5,4},{6,4},{16,4},{18,3},{20,2},{12,1},{2,1},{3,1},{4,1},{14,1},{12,2},{20,3},{10,3},{1,3},{11,3},{13,4},{3,4},{2,4},{1,4},{10,4},{9,4},{19,4},{17,3},{15,2},{13,1},{11,6},{19,5},{9,5},{8,5},{7,5},{6,5},{5,5},{15,5},{17,6},{7,6},{8,6},{18,6},{16,1},{14,2},{4,2},{5,2},{6,2},{16,2},{18,1},{20,6},{12,5},{2,5},{3,5},{4,5},{14,5},{12,6},{20,1},{10,1}}},g2=System`Graph[UndirectedEdge@@@Join[Partition[base,2,1,1],Complement[d20e,Sort/@Partition[base,2,1,1]]], GraphLayout->"CircularEmbedding"]]}

ToEntity[g2]

LCFEmbeddingQ[g2]

Mean[GraphEmbedding[g2]]

Order 5 mirror symmetry with this path that uses a smaller grid.

pont={{0,-1},{-((Sqrt[3])/2),-(1/2)},{((Sqrt[3])/2),-(1/2)},{0,0},{-(Sqrt[3]),0},{(Sqrt[3]),0},{-((Sqrt[3])/2),(1/2)},{((Sqrt[3])/2),(1/2)},{0,1},{-(Sqrt[3]),1},{(Sqrt[3]),1},{-((Sqrt[3])/2),(3/2)},{((Sqrt[3])/2),(3/2)},{0,2}};

lin=Select[Subsets[pont,{2}],EuclideanDistance@@#==1&];

path={{-(1/(Sqrt[3])),(1/2)},{-(1/(Sqrt[3])),0},{-(1/(2 (Sqrt[3]))),-(1/4)},{(1/(2 (Sqrt[3]))),-(1/4)},{(1/(Sqrt[3])),0},{(1/(Sqrt[3])),(1/2)},{(1/(Sqrt[3])),1},{(1/(2 (Sqrt[3]))),(5/4)},{-(1/(2 (Sqrt[3]))),(7/4)},{-(5/(4 (Sqrt[3]))),(11/8)},{-(2/(Sqrt[3])),1},{-(5/(2 (Sqrt[3]))),(1/2)},{-(2/(Sqrt[3])),0},{-(5/(4 (Sqrt[3]))),-(1/4)},{-(1/(2 (Sqrt[3]))),-(1/2)},{(1/(2 (Sqrt[3]))),-(1/2)},{(5/(4 (Sqrt[3]))),-(1/4)},{(2/(Sqrt[3])),0},{(5/(2 (Sqrt[3]))),(1/2)},{(2/(Sqrt[3])),1},{(5/(4 (Sqrt[3]))),(11/8)},{(1/(2 (Sqrt[3]))),(7/4)},{-(1/(2 (Sqrt[3]))),(5/4)},{-(1/(Sqrt[3])),1}};

graphic2={Graphics[{Disk[#,.03]&/@pont, Line/@lin,Green,BSplineCurve[path,SplineClosed->True]}],With[{base={{10,3},{9,3},{8,3},{7,3},{17,3},{19,4},{11,5},{1,5},{10,5},{20,5},{18,6},{8,6},{9,6},{19,6},{11,1},{1,1},{10,1},{20,1},{18,2},{8,2},{9,2},{10,2},{1,2},{2,2},{12,2},{20,3},{18,4},{8,4},{9,4},{10,4},{1,4},{2,4},{12,4},{14,3},{16,2},{18,1},{20,6},{10,6},{1,6},{2,6},{12,6},{14,5},{16,4},{18,3},{20,2},{12,1},{2,1},{3,1},{4,1},{14,1},{16,6},{18,5},{20,4},{12,3},{2,3},{3,3},{4,3},{5,3},{6,3},{16,3},{14,4},{12,5},{2,5},{3,5},{4,5},{5,5},{6,5},{16,5},{14,6},{4,6},{3,6},{13,6},{15,1},{5,1},{6,1},{16,1},{14,2},{4,2},{3,2},{13,2},{15,3},{17,4},{7,4},{6,4},{5,4},{4,4},{3,4},{13,4},{15,5},{17,6},{7,6},{6,6},{5,6},{15,6},{13,5},{11,4},{19,3},{17,2},{7,2},{6,2},{5,2},{15,2},{13,1},{11,6},{19,5},{9,5},{8,5},{7,5},{17,5},{15,4},{13,3},{11,2},{19,1},{9,1},{8,1},{7,1},{17,1},{19,2},{11,3},{1,3}}},g1=System`Graph[UndirectedEdge@@@Join[Partition[base,2,1,1],Complement[d20e,Sort/@Partition[base,2,1,1]]], GraphLayout->"CircularEmbedding"]]}

ToEntity[g1]

LCFEmbeddingQ[g1]

Mean[GraphEmbedding[g1]]

This one doesn’t roll with a closed path but has order 10 mirror symmetry.

base={{1,1},{10,1},{20,1},{18,2},{8,2},{9,2},{19,2},{11,3},{1,3},{2,3},{12,3},{20,4},{10,4},{1,4},{11,4},{13,5},{3,5},{4,5},{14,5},{12,6},{2,6},{1,6},{11,6},{13,1},{3,1},{2,1},{12,1},{20,2},{10,2},{1,2},{11,2},{13,3},{3,3},{4,3},{14,3},{12,4},{2,4},{3,4},{13,4},{15,5},{5,5},{6,5},{16,5},{14,6},{4,6},{3,6},{13,6},{15,1},{5,1},{4,1},{14,1},{12,2},{2,2},{3,2},{13,2},{15,3},{5,3},{6,3},{16,3},{14,4},{4,4},{5,4},{15,4},{17,5},{7,5},{8,5},{18,5},{16,6},{6,6},{5,6},{15,6},{17,1},{7,1},{6,1},{16,1},{14,2},{4,2},{5,2},{15,2},{17,3},{7,3},{8,3},{18,3},{16,4},{6,4},{7,4},{17,4},{19,5},{9,5},{10,5},{20,5},{18,6},{8,6},{7,6},{17,6},{19,1},{9,1},{8,1},{18,1},{16,2},{6,2},{7,2},{17,2},{19,3},{9,3},{10,3},{20,3},{18,4},{8,4},{9,4},{19,4},{11,5},{1,5},{2,5},{12,5},{20,6},{10,6},{9,6},{19,6},{11,1}};

allin=Join[Partition[base,2,1,1],Complement[d20e,Sort/@Partition[base,2,1,1]]];

g20=System`Graph[UndirectedEdge@@@allin, GraphLayout->"CircularEmbedding"]

ToEntity[g20]

LCFEmbeddingQ[g20]

Mean[GraphEmbedding[g20]]

Graphic

GraphicsRow[Flatten@{graphic1,graphic2},ImageSize->500]//Quiet

Graphs

GraphData["RollingIcosahedronGraph","#"]

GraphData["RollingIcosahedronGraph","LCFSignature"]

GraphData["RollingIcosahedronGraph","LCFNotations"][[2,All,-1]]

GraphData["RollingIcosahedronGraph","Graph","All"]

"RollingOctahedronGraph" == "NauruGraph"

From Ed Pegg. Jr.
November 2, 2018

Rolling octahedron ->  Nauru graph.  Only 24 orientations due to parity.
Following the outer circle uses 4 rows of 6 triangles, so it's not a closed curve.

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

GraphData["RollingOctahedronGraph","#"]

Image

From Ed Pegg, Jr.
November 15, 2018

pp=SortBy[Flatten[Table[{a+Mod[b,2]/2,b Sqrt[3]/2},{a,-4,4},{b,-3,3}],1], N[AbsArg[#.{1,I}]]&];

unit=Select[Subsets[Range[63],{2}], EuclideanDistance@@pp[[#]]==1&];

tri=SortBy[First/@#&/@FindCycle[Graph[UndirectedEdge@@@unit],{3},All],N[AbsArg[Mean[pp[[#]]].{1,I}]]&];

trian=Join[Take[tri,{7,24}],tri[[{25,29,33,27,31,35}]]]

triang={{17,11,5},{7,13,19},{3,15,9},{5,6,12},{7,8,2},{4,3,10},{18,13,6},{2,14,9},{11,4,16},{17,28,12},{20,8,19},{10,24,15},{13,18,30},{14,9,22},{11,26,16},{17,5,12},{7,19,8},{15,10,3},{18,12,6},{2,8,14},{4,16,10},{3,2,9},{11,5,4},{6,13,7}};

{Red,Green,Blue,Black,White,Gray,Cyan,Magenta,Yellow,Brown,Orange,Pink,Purple,LightRed,LightGreen,LightBlue,LightGray,LightCyan,LightMagenta,LightYellow,LightBrown,LightOrange,LightPink,LightPurple}

col={Green, Blue, Brown, Red, LightBlue,LightGray,LightGreen,LightPurple};

hex={{3,-(Sqrt[3])},{3,(Sqrt[3])},{0,2 (Sqrt[3])},{-3,(Sqrt[3])},{-3,-(Sqrt[3])},{0,-2 (Sqrt[3])}};

lin1={{-(3/2),(5/(2 (Sqrt[3])))},{-(3/2),((3 (Sqrt[3]))/2)}};
lin2={{-(3/8),((15 (Sqrt[3]))/8)},{(21/8),-((9 (Sqrt[3]))/8)}};

lin3={{0,((Sqrt[3])/2)},{0,-((Sqrt[3])/2)}};

Graphics[Rotate[{EdgeForm[{Blue}],
White, Polygon[hex],Black,
Table[Line[lin1.RotationMatrix[n Pi/3]],{n,0,5}],
Table[Line[lin2.RotationMatrix[n Pi/3]],{n,0,5}],
Table[Line[lin3.RotationMatrix[n Pi/3]],{n,0,2}],
EdgeForm[{Black, Thick}],
Table[{col[[Ceiling[(k)/3]]],Polygon[pp[[triang[[k]]]]], White,Disk[Mean[pp[[triang[[k]]]]]+If[k>12,-1,1](CirclePoints[3][[Mod[k,3,1]]])/3,.05]},{k,1,24}]
},90Degree]]

Graphs

GraphData["RollingOctahedronGraph","#"]

GraphData["RollingOctahedronGraph","LCFSignature"]

GraphData["RollingOctahedronGraph","Graph","All"]

"RollingPentagonalDipyramidGraph" == {GeneralizedPetersen", {30, 11}}

GraphData["RollingPentagonalDipyramidGraph","#"]

Construction

From Ed Pegg Jr. Nov 22-23, 2019

RollingPentagonalDipyramidGraph1={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{36,37},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45},{45,46},{46,47},{47,48},{48,49},{49,50},{50,51},{51,52},{52,53},{53,54},{54,55},{55,56},{56,57},{57,58},{58,59},{59,60},{27,34},{24,37},{16,31},{30,45},{21,40},{2,23},{5,26},{8,29},{12,33},{28,49},{32,53},{35,56},{38,59},{18,43},{9,36},{14,41},{20,47},{25,52},{6,39},{11,44},{17,50},{22,55},{13,48},{3,42},{19,58},{10,51},{1,46},{15,60},{7,54},{4,57},{1,60}};

g1=Graph[Range[60],UndirectedEdge@@@RollingPentagonalDipyramidGraph1,VertexCoordinates->CirclePoints[60]]

RollingPentagonalDipyramidGraph2={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{36,37},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45},{45,46},{46,47},{47,48},{48,49},{49,50},{50,51},{51,52},{52,53},{53,54},{54,55},{55,56},{56,57},{57,58},{58,59},{59,60},{9,16},{15,22},{27,34},{39,46},{45,52},{1,12},{19,30},{31,42},{49,60},{5,18},{13,26},{24,37},{35,48},{43,56},{21,40},{2,29},{6,33},{11,38},{17,44},{23,50},{28,55},{32,59},{3,36},{8,41},{14,47},{20,53},{25,58},{10,51},{7,54},{4,57},{1,60}};

g2=Graph[Range[60],UndirectedEdge@@@RollingPentagonalDipyramidGraph2,VertexCoordinates->CirclePoints[60]]

IsomorphicGraphQ[g1,g2]

Circulant

CirculantGraphQ@g1

GeneralizedPetersen

GeneralizedPetersenGraphQ@g1

GeneralizedPetersenIndices[g1,All]

IsomorphicGraphQ[g1,PetersenGraph[30,11]]

LCF

LCFFromEmbedding/@{g1,g2}

Length[FindHamiltonianCycle[g1,All]]//Timing

Length[lcf=LCF[g1,All]]//Timing

Tally@lcf[[All,2]]

nicelcfs=Take[lcf,8]

ToCommonEdges[LCFGraph@@#,PetersenGraph[30,11]]&/@nicelcfs//N

Graphs

GraphData["RollingPentagonalDipyramidGraph","#"]

GraphData["RollingPentagonalDipyramidGraph","LCFSignature"]

GraphData["RollingPentagonalDipyramidGraph","Graph","All"]

GraphDataString

file=OpenWrite["~/rolling-pent-dipyr.m"]

WriteString[file,GraphDataString[PetersenGraph[30,11],
"StandardName"->{"GeneralizedPetersen",{30,11}},
"AlternateStandardNames"->{"Gp30,11","GP30,11","RollingPentagonalDipyramidGraph"},
"AlternateNames"->{"rolling pentgonal dipyramid graph"},
"Information"->"GeneralizedPetersenGraph",
"Classes"->{"GeneralizedPetersen"},
"NotationRules"->{"GeneralizedPetersen"->{30,11}},
TimeConstraint->60,
Debug->True
]]

Close[file]

"RollingSnubDisphenoidGraph"

Construction

From Ed Pegg Jr. Nov 22-23, 2019

RollingSnubDisphenoidGraph1={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{36,37},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45},{45,46},{46,47},{47,48},{48,49},{49,50},{50,51},{51,52},{52,53},{53,54},{54,55},{55,56},{56,57},{57,58},{58,59},{59,60},{60,61},{61,62},{62,63},{63,64},{64,65},{65,66},{66,67},{67,68},{68,69},{69,70},{70,71},{71,72},{15,22},{33,40},{51,58},{28,37},{36,45},{12,25},{30,43},{48,61},{24,39},{34,49},{8,29},{21,42},{26,47},{31,52},{44,65},{5,32},{19,46},{23,50},{27,54},{41,68},{2,35},{20,53},{38,71},{17,56},{10,55},{14,59},{18,63},{6,57},{11,62},{16,67},{3,60},{13,70},{7,66},{1,64},{9,72},{4,69},{1,72}};

g1=Graph[Range[72],UndirectedEdge@@@RollingSnubDisphenoidGraph1,VertexCoordinates->CirclePoints[72]]

RollingSnubDisphenoidGraph2={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{36,37},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45},{45,46},{46,47},{47,48},{48,49},{49,50},{50,51},{51,52},{52,53},{53,54},{54,55},{55,56},{56,57},{57,58},{58,59},{59,60},{60,61},{61,62},{62,63},{63,64},{64,65},{65,66},{66,67},{67,68},{68,69},{69,70},{70,71},{71,72},{8,17},{20,29},{32,41},{44,53},{56,65},{4,25},{16,37},{28,49},{40,61},{7,34},{11,38},{19,46},{23,50},{31,58},{35,62},{43,70},{3,36},{9,42},{15,48},{21,54},{27,60},{33,66},{39,72},{6,45},{12,51},{18,57},{24,63},{30,69},{2,47},{10,55},{14,59},{22,67},{26,71},{1,52},{13,64},{5,68},{1,72}};

g2=Graph[Range[72],UndirectedEdge@@@RollingSnubDisphenoidGraph2,VertexCoordinates->CirclePoints[72]]

IsomorphicGraphQ[g1,g2]

Embeddings

Names

GraphData["RollingSnubDisphenoidGraph","StandardName"]

GraphData["RollingSnubDisphenoidGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["RollingSnubDisphenoidGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["RollingSnubDisphenoidGraph","Graph","Degenerate"]

Perspective

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

Perspective construction

GraphData["RollingSnubDisphenoidGraph","Polyhedron"]

Bilateral

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

Circular

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

Planar

GraphData["RollingSnubDisphenoidGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData["RollingSnubDisphenoidGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["RollingSnubDisphenoidGraph"],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["RollingSnubDisphenoidGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["RollingSnubDisphenoidGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["RollingSnubDisphenoidGraph","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["RollingSnubDisphenoidGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union//Timing

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["RollingSnubDisphenoidGraph","Circulant"]

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

Complement graph

GraphData["RollingSnubDisphenoidGraph","ComplementGraph","Name"]

Line graph

GraphData["RollingSnubDisphenoidGraph","Line"]

LineGraphQ[GraphData["RollingSnubDisphenoidGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["RollingSnubDisphenoidGraph"]]

Halin

GraphData["RollingSnubDisphenoidGraph","Halin"]

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

Rigid

GraphData["RollingSnubDisphenoidGraph","Rigid"]

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

Flexible

GraphData["RollingSnubDisphenoidGraph","Flexible"]

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

LCF

GraphData["RollingSnubDisphenoidGraph","LCF"]

GraphData["RollingSnubDisphenoidGraph","HamiltonianCycleCount"]

GraphData["RollingSnubDisphenoidGraph","LCFSignature"]

GraphData["RollingSnubDisphenoidGraph","LCFNotations"]

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

Tally[LCFNotation[#][[2]]&/@%]

LCF compute all

Divisors[GraphData["RollingSnubDisphenoidGraph","V"]]

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

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

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName["RollingSnubDisphenoidGraph",".m.gz"]])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2])]//Timing

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

UnitDistance

GraphData["RollingSnubDisphenoidGraph","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing

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

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

MinimalCrossing construction

CrossingNumber[GraphData["RollingSnubDisphenoidGraph"],TimeConstraint->10]//AbsoluteTiming

CrossingNumber[GraphData["RollingSnubDisphenoidGraph"],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData["RollingSnubDisphenoidGraph"],"CrossingNumber"->42]]

RecognizeGraph[g]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Default embedding

g=Graph@GraphData["RollingSnubDisphenoidGraph","Edges"]

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

RecognizeGraph[g]

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["RollingSnubDisphenoidGraph"],"CrossingNumber"->42]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["RollingSnubDisphenoidGraph","Edges"]]

3D All

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

3D UnitDistance

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

GraphDataString

WriteString[file,GraphDataString[g2,
"StandardName"->"RollingSnubDisphenoidGraph",
"Name"->"rolling snub disphenoid graph",
"Information"->"RollingPolyhedronGraph",
TimeConstraint->60,
Debug->True
]]

Close[file]

"RollingTetrahedronGraph" == "CubicalGraph"

Description from Ed Pegg, Jr. Nov 5, 2018

Rolling tetrahedron -> Cubical graph.

Took me awhile to realize there are only 8 orientations.

The triangular grid of 8 orientations is a diamond shape.  The full connections are like the attached, which gives the cubical graph.

Graphs

GraphData["RollingTetrahedronGraph","#"]

GraphData["RollingTetrahedronGraph","LCFSignature"]

GraphData["RollingTetrahedronGraph","Graph","All"]

"RollingTriangularDipyramidGraph"

Construction

From Ed Pegg, Jr.
Nov 22, 2019

coord={{0,-8},{0,-4},{0,4},{0,8},{-4 (Sqrt[3]),-4},{-4 (Sqrt[3]),-2},{-4 (Sqrt[3]),2},{-4 (Sqrt[3]),4},{-3 (Sqrt[3]),-5},{-3 (Sqrt[3]),-1},{-3 (Sqrt[3]),1},{-3 (Sqrt[3]),5},{-2 (Sqrt[3]),-4},{-2 (Sqrt[3]),-2},{-2 (Sqrt[3]),2},{-2 (Sqrt[3]),4},{-(Sqrt[3]),-7},{-(Sqrt[3]),-5},{-(Sqrt[3]),5},{-(Sqrt[3]),7},{(Sqrt[3]),-7},{(Sqrt[3]),-5},{(Sqrt[3]),5},{(Sqrt[3]),7},{2 (Sqrt[3]),-4},{2 (Sqrt[3]),-2},{2 (Sqrt[3]),2},{2 (Sqrt[3]),4},{3 (Sqrt[3]),-5},{3 (Sqrt[3]),-1},{3 (Sqrt[3]),1},{3 (Sqrt[3]),5},{4 (Sqrt[3]),-4},{4 (Sqrt[3]),-2},{4 (Sqrt[3]),2},{4 (Sqrt[3]),4}};

edge={{1,17},{1,21},{2,18},{2,22},{3,19},{3,23},{4,20},{4,24},{5,6},{5,9},{6,10},{7,8},{7,11},{8,12},{9,13},{10,11},{10,14},{11,15},{12,16},{13,14},{13,18},{15,16},{16,19},{17,18},{19,20},{21,22},{22,25},{23,24},{23,28},{25,26},{25,29},{26,30},{27,28},{27,31},{28,32},{29,33},{30,31},{30,34},{31,35},{32,36},{33,34},{35,36},
{2,3},{14,27},{15,26},{1,4},{8,33},{5,36},{20,35},{6,21},{9,12},{29,32},{7,24},{17,34}};

Sort[edge]

So 1-4 overlaps vertices 2 & 3

Graphics[{Cyan,Line[coord[[#]]]&/@edge,Black,Table[Text[n,coord[[n]]],{n,36}]}]

g1=Graph[Range[36],UndirectedEdge@@@edge,VertexCoordinates->coord,VertexLabels->"Name"]

DegenerateEmbeddingQ[g1]

ToCommonEdges[g1,g2]

arg={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{1,6},{7,12},{13,18},{19,24},{25,30},{31,36},{3,10},{9,16},{15,22},{21,28},{27,34},{5,20},{11,26},{17,32},{2,23},{8,29},{14,35},{4,33},{1,36}};

g2=Graph[Range[36],UndirectedEdge@@@arg,VertexCoordinates->CirclePoints[36]]

IsomorphicGraphQ[g1,g2]

RecognizeGraph/@{g1,g2}

PolyhedralEmbedding (not sure what exactly this is)

poly=Polyhedron[{{(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["-0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},{(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ]),(NumericalApproximation[Root, (RowDefault["-1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.621", FEExpressionsNumericalApproximationElider]), Root[-1+4 ((#1)^2)-16 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.338", FEExpressionsNumericalApproximationElider]), Root[-1+12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ]),(NumericalApproximation[Root, (RowDefault["1.14", FEExpressionsNumericalApproximationElider]), Root[-1-12 ((#1)^2)-32 ((#1)^4)+32 ((#1)^6)&,2], ])},
{(NumericalApproximation[Root, (RowDefault["-1.85", FEExpressionsNumericalApproximationElider]), Root[121-1064 ((#1)^2)+3248 ((#1)^4)-6464 ((#1)^6)+7168 ((#1)^8)-5120 ((#1)^10)+1024 ((#1)^12)&,1], ]),0,0},{0,(NumericalApproximation[Root, (RowDefault["-1.85", FEExpressionsNumericalApproximationElider]), Root[121-1064 ((#1)^2)+3248 ((#1)^4)-6464 ((#1)^6)+7168 ((#1)^8)-5120 ((#1)^10)+1024 ((#1)^12)&,1], ]),0},{0,0,(NumericalApproximation[Root, (RowDefault["1.85", FEExpressionsNumericalApproximationElider]), Root[121-1064 ((#1)^2)+3248 ((#1)^4)-6464 ((#1)^6)+7168 ((#1)^8)-5120 ((#1)^10)+1024 ((#1)^12)&,4], ])},{(NumericalApproximation[Root, (RowDefault["1.85", FEExpressionsNumericalApproximationElider]), Root[121-1064 ((#1)^2)+3248 ((#1)^4)-6464 ((#1)^6)+7168 ((#1)^8)-5120 ((#1)^10)+1024 ((#1)^12)&,4], ]),0,0},{0,(NumericalApproximation[Root, (RowDefault["1.85", FEExpressionsNumericalApproximationElider]), Root[121-1064 ((#1)^2)+3248 ((#1)^4)-6464 ((#1)^6)+7168 ((#1)^8)-5120 ((#1)^10)+1024 ((#1)^12)&,4], ]),0},{0,0,(NumericalApproximation[Root, (RowDefault["-1.85", FEExpressionsNumericalApproximationElider]), Root[121-1064 ((#1)^2)+3248 ((#1)^4)-6464 ((#1)^6)+7168 ((#1)^8)-5120 ((#1)^10)+1024 ((#1)^12)&,1], ])}},{{3,1,17},{3,17,9},{3,19,2},{3,9,19},{1,4,20},{1,20,11},{1,11,17},{2,19,12},{2,18,4},{2,12,18},{4,18,10},{4,10,20},{17,11,13},{19,9,15},{18,12,14},{20,10,16},{9,21,15},{11,23,13},{12,24,14},{10,22,16},{13,23,7},{13,7,21},{15,21,5},{15,5,24},{16,22,6},{16,6,23},{14,24,8},{14,8,22},{21,7,5},{23,6,7},{24,5,8},{22,8,6},{1,3,25},{3,2,25},{2,4,25},{4,1,25},{21,9,26},{9,17,26},{17,13,26},{13,21,26},{24,12,27},{12,19,27},{19,15,27},{15,24,27},{10,18,29},{18,14,29},{14,22,29},{22,10,29},{11,20,30},{20,16,30},{16,23,30},{23,11,30},{8,5,28},{5,7,28},{7,6,28},{6,8,28}}]

Graphics3D[poly]

PolyhedronGraph[poly]

RecognizeGraph[%]

Embeddings

Names

GraphData["RollingTriangularDipyramidGraph","StandardName"]

GraphData["RollingTriangularDipyramidGraph","StandardNames"]

Primary

GraphData["RollingTriangularDipyramidGraph"]//StyleGraphs

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["RollingTriangularDipyramidGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Perspective

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

Perspective construction

GraphData["RollingTriangularDipyramidGraph","Polyhedron"]

Bilateral

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

Circular

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

Planar

GraphData["RollingTriangularDipyramidGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData["RollingTriangularDipyramidGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["RollingTriangularDipyramidGraph"],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["RollingTriangularDipyramidGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["RollingTriangularDipyramidGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,10}],Max[OuterFace[#]]<=GraphData["RollingTriangularDipyramidGraph","V"]&]]//AbsoluteTiming

Table[MinimalCrossingGraph[GraphData["RollingTriangularDipyramidGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,10}]//Union//AbsoluteTiming

GraphPlot@RotateGraph[,Pi/6]

GraphData["RollingTriangularDipyramidGraph","V"]

v={#/9,#2/11}&@@@Join[{{0,0},{9,0},{1,1},{2,1},{3,1},{6,1},{7,1},{8,1},{3,2},{4,2},{5,2},{6,2},{4,3},{5,3}},Sequence@@Table[{i,j},{i,4,5},{j,4,9}],{{3,9},{6,9},{1,10},{2,10},{3,10},{6,10},{7,10},{8,10},{0,11},{9,11}}];
g=Graph[Range@Length@v,UndirectedEdge@@@{e[11,12,6,7,8,2,4],e[10,9,5,4,3,1,7],e[1,35,33,34,36,2],e[36,30,29,35],e[30,31,27,9],e[33,32,28,12],e[27,20,32],e[28,26,31],e[5,11,14,21,22,23,24,25,26],e[20,19,18,17,16,15,13,10,6],{19,23},{17,25},{13,22},{14,16},{3,18},{29,15},{24,8},{21,34}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

RectilinearCrossingCount@g

GraphPlot@RotateGraph[,Pi/6]

GraphPlot@

GraphPlot@RotateGraph[,-2Pi/5]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

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

Halin

GraphData["RollingTriangularDipyramidGraph","Halin"]

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

LCF

GraphData["RollingTriangularDipyramidGraph","LCF"]

GraphData["RollingTriangularDipyramidGraph","LCFSignature"]

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

LCF compute all

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

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

lcf

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs]

gs

UnitDistance

GraphData["RollingTriangularDipyramidGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData["RollingTriangularDipyramidGraph"],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

gs=UniqueEmbeddings[l]

Matchstick

GraphData["RollingTriangularDipyramidGraph","Matchstick"]

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

3D default

Graph3D[GraphData["RollingTriangularDipyramidGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["RollingTriangularDipyramidGraph","Polyhedral"]

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

GraphDataString

file=OpenWrite["~/rolling-dipyr.m"]

WriteString[file,GraphDataString[g2,
"StandardName"->"RollingTriangularDipyramidGraph",
"Name"->"rolling triangular dipyramid graph",
"Information"->"RollingPolyhedronGraph",
TimeConstraint->60,
Debug->True
]]

Close[file]

"RollingTriaugmentedTriangularPrismGraph"

Embeddings

GraphData["RollingTriaugmentedTriangularPrismGraph","#"]

Construction

From Ed Pegg Jr. Nov 22-23, 2019

RollingTriaugmentedTriangularPrismGraph1={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{36,37},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45},{45,46},{46,47},{47,48},{48,49},{49,50},{50,51},{51,52},{52,53},{53,54},{54,55},{55,56},{56,57},{57,58},{58,59},{59,60},{60,61},{61,62},{62,63},{63,64},{64,65},{65,66},{66,67},{67,68},{68,69},{69,70},{70,71},{71,72},{72,73},{73,74},{74,75},{75,76},{76,77},{77,78},{78,79},{79,80},{80,81},{81,82},{82,83},{83,84},{4,11},{18,25},{32,39},{46,53},{60,67},{74,81},{8,17},{12,21},{22,31},{26,35},{36,45},{40,49},{50,59},{54,63},{64,73},{68,77},{1,24},{5,28},{14,37},{20,43},{29,52},{33,56},{42,65},{48,71},{57,80},{61,84},{6,41},{16,51},{34,69},{44,79},{19,58},{27,66},{2,47},{10,55},{30,75},{38,83},{13,62},{23,72},{9,70},{15,76},{3,78},{7,82},{1,84}};

g1=Graph[Range[84],UndirectedEdge@@@RollingTriaugmentedTriangularPrismGraph1,VertexCoordinates->CirclePoints[84]]

RollingTriaugmentedTriangularPrismGraph2={{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,11},{11,12},{12,13},{13,14},{14,15},{15,16},{16,17},{17,18},{18,19},{19,20},{20,21},{21,22},{22,23},{23,24},{24,25},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{32,33},{33,34},{34,35},{35,36},{36,37},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45},{45,46},{46,47},{47,48},{48,49},{49,50},{50,51},{51,52},{52,53},{53,54},{54,55},{55,56},{56,57},{57,58},{58,59},{59,60},{60,61},{61,62},{62,63},{63,64},{64,65},{65,66},{66,67},{67,68},{68,69},{69,70},{70,71},{71,72},{72,73},{73,74},{74,75},{75,76},{76,77},{77,78},{78,79},{79,80},{80,81},{81,82},{82,83},{83,84},{8,21},{22,35},{36,49},{50,63},{64,77},{14,29},{28,43},{42,57},{56,71},{3,20},{10,27},{17,34},{24,41},{31,48},{38,55},{45,62},{52,69},{59,76},{66,83},{5,30},{12,37},{19,44},{26,51},{33,58},{40,65},{47,72},{54,79},{4,39},{18,53},{32,67},{46,81},{11,60},{25,74},{2,61},{9,68},{16,75},{23,82},{6,73},{13,80},{1,70},{15,84},{7,78},{1,84}};

g2=Graph[Range[84],UndirectedEdge@@@RollingTriaugmentedTriangularPrismGraph2,VertexCoordinates->CirclePoints[84]]

IsomorphicGraphQ[g1,g2]

Names

GraphData["RollingTriaugmentedTriangularPrismGraph","StandardName"]

GraphData["RollingTriaugmentedTriangularPrismGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["RollingTriaugmentedTriangularPrismGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["RollingTriaugmentedTriangularPrismGraph","Graph","Degenerate"]

Perspective

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

Perspective construction

PolyhedronGraph[GraphData["RollingTriaugmentedTriangularPrismGraph","Polyhedron"]]

Bilateral

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

Circular

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

Planar

GraphData["RollingTriaugmentedTriangularPrismGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData["RollingTriaugmentedTriangularPrismGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["RollingTriaugmentedTriangularPrismGraph"],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["RollingTriaugmentedTriangularPrismGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["RollingTriaugmentedTriangularPrismGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["RollingTriaugmentedTriangularPrismGraph","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["RollingTriaugmentedTriangularPrismGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["RollingTriaugmentedTriangularPrismGraph","Circulant"]

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

Complement graph

GraphData["RollingTriaugmentedTriangularPrismGraph","ComplementGraph","Name"]

Line graph

GraphData["RollingTriaugmentedTriangularPrismGraph","Line"]

LineGraphQ[GraphData["RollingTriaugmentedTriangularPrismGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["RollingTriaugmentedTriangularPrismGraph"]]

Halin

GraphData["RollingTriaugmentedTriangularPrismGraph","Halin"]

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

Rigid

GraphData["RollingTriaugmentedTriangularPrismGraph","Rigid"]

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

Flexible

GraphData["RollingTriaugmentedTriangularPrismGraph","Flexible"]

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

LCF

GraphData["RollingTriaugmentedTriangularPrismGraph","LCF"]

GraphData["RollingTriaugmentedTriangularPrismGraph","HamiltonianCycleCount"]

GraphData["RollingTriaugmentedTriangularPrismGraph","LCFSignature"]

GraphData["RollingTriaugmentedTriangularPrismGraph","LCFNotations"]

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

Tally[LCFNotation[#][[2]]&/@%]

LCF compute all

Divisors[GraphData["RollingTriaugmentedTriangularPrismGraph","V"]]

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

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

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName["RollingTriaugmentedTriangularPrismGraph",".m.gz"]])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2])]//Timing

Length[gs]

gs

UnitDistance

GraphData["RollingTriaugmentedTriangularPrismGraph","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing

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

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

Default embedding

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

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

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["RollingTriaugmentedTriangularPrismGraph"],"CrossingNumber"->75]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["RollingTriaugmentedTriangularPrismGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["RollingTriaugmentedTriangularPrismGraph","Polyhedron"]

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

GraphDataString

WriteString[file,GraphDataString[g2,
"StandardName"->"RollingTriaugmentedTriangularPrismGraph",
"Name"->"rolling triaugmented triangular prism graph",
"Information"->"RollingPolyhedronGraph",
TimeConstraint->60,
Debug->True
]]

Close[file]