Cubeplex Graph

Author

Eric W. Weisstein
November 9, 2022

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

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

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

Embeddings

GraphData["CubeplexGraph","StandardName"]

Primary

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

All

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

Embedding types

GraphDataEmbeddings[GraphData["CubeplexGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["CubeplexGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

g=RotateGraph[MinimalCrossingGraph[GraphData["CubeplexGraph"],"CrossingNumber"->cn]]

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["CubeplexGraph","Circulant"]

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

Halin

GraphData["CubeplexGraph","Halin"]

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

LCF

GraphData["CubeplexGraph","LCF"]

GraphData["CubeplexGraph","LCFSignature"]

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

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

LCF compute

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

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

gs=LCFGraph@@@lcf//StyleGraphs

gs=Join[With[{g=BilateralLCFEmbedding[#]},If[MissingQ[g],#,g]]&/@LCFGraph@@@DeleteCases[lcf,{_,1}],DeleteMissing[BilateralLCFEmbedding/@LCFGraph@@@Cases[lcf,{_,1}]]]

UnitDistance

GraphData["CubeplexGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["CubeplexGraph","VertexList"],GraphData["CubeplexGraph","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData["CubeplexGraph","Matchstick"]

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

3D default

Graph3D[GraphData["CubeplexGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["CubeplexGraph","Polyhedral"]

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

Construction

Fischer and Little (Subscript[Γ, 1])

https://www.sciencedirect.com/science/article/pii/S0095895608000038

v=CirclePoints[{1,0},12];
gamma1=Graph[Range[Length[v]],UndirectedEdge@@@Sort[Join[Partition[Range[12],2,1,1],{{4,10},{1,7},{2,9},{6,11},{5,8},{3,12}}]],VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[gamma1]

LCF[gamma1,All]

Norine and Thomas (a) Cubeplex

v=Join[Sequence@@Table[{i,j},{i,0,4},{j,0,1}],{{0,2},{3,2}}];
cubeplex=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{1,4},{2,3},{3,5},{7,9},{8,12},{10,12},{10,11},{4,12},{5,6},{7,8},{1,2},{2,11},{6,7},{5,8},{3,4},{9,10},{6,11},{1,9}}],VertexCoordinates->v,VertexLabels->"Name",EdgeShapeFunction->{1\[UndirectedEdge]9->"CurvedArc"}]

figa=Graph[Range[Length[v]],DirectedEdge@@@Sort[{{1,4},{2,3},{3,5},{7,9},{8,12},{10,12},{10,11},{4,12},{5,6},{7,8},{1,2},{2,11},{6,7},{5,8},{3,4},{9,10},{6,11},{9,1}}],VertexCoordinates->v,PlotLabel->"(a) Cubeplex.",LabelStyle->Black,EdgeStyle->Black,VertexStyle->Black,EdgeShapeFunction->{"Line",9\[DirectedEdge]1->"CurvedArc"}]

r=RecognizeGraph[cubeplex]

vs=ToCommonEdges[cubeplex,GraphData[r]]

rcn=GraphData[r,"RCN"]

Norine and Thomas: (b) Twinplex [actually Cubeplex]

v=Join[Sequence@@Table[{i,j},{i,0,4},{j,0,1}],{{0,2},{3,2}}];
wrongtwinplex=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{1,4},{2,3},{3,5},{7,9},{10,12},{10,11},{4,12},{7,8},{1,2},{2,11},{6,7},{5,8},{9,10},{3,6},{4,5},{8,12},{6,11},{1,9}}],VertexCoordinates->v,VertexLabels->"Name",EdgeShapeFunction->{1\[UndirectedEdge]9->"CurvedArc"}]

figb=Graph[Range[Length[v]],DirectedEdge@@@Sort[{{1,4},{2,3},{3,5},{7,9},{10,12},{10,11},{4,12},{7,8},{1,2},{2,11},{6,7},{5,8},{9,10},{3,6},{4,5},{8,12},{6,11},{9,1}}],VertexCoordinates->v,PlotLabel->"(b) Twinplex.",EdgeShapeFunction->{"Line",9\[DirectedEdge]1->"CurvedArc"},LabelStyle->Black,EdgeStyle->Black,VertexStyle->Black]

r=RecognizeGraph[wrongtwinplex]

vs=ToCommonEdges[wrongtwinplex,GraphData[r]]

rcn=GraphData[r,"RCN"]

Figure

GraphicsRow[{figa,figb},ImageSize->500]

Properties

IsomorphicGraphQ@@{wrongtwinplex,cubeplex,gamma1}

CrossingNumber

CrossingNumber[gamma1]

Girth

GirthByCycles[gamma1]

Sort@Tally[GraphData[#,"Girth"]&/@GraphData["Cubic",12]]

max=With[{cubic=GraphData["Cubic",12]},Pick[cubic,GraphData[#,"Girth"]&/@cubic,5]]

LCF

VertexCount

VertexCount[g1]