Cubical Graph

Author

Eric W. Weisstein
March 3, 2024

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

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

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

Embeddings

<<MathWorld`Graphs`

Names

GraphData["CubicalGraph","StandardName"]

GraphData["CubicalGraph","StandardNames"]

Primary

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

Read and Wilson

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["CubicalGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

CVT construction

g=CubicVertexTransitiveGraph[8]

RecognizeGraph@g

Degenerate

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

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

HoneycombToroidal construction

GraphData["CubicalGraph","NotationRules","HoneycombToroidal"]

HoneycombToroidalGraph[1,8,3]

RecognizeGraph[%]

GeneralizedHoneycombGraph construction

With[{n=8},Cases[Table[{k,g=GeneralizedHoneycombGraph[n,k],RecognizeGraph@g},{k,n-1}],{__,"CubicalGraph"}]]//Timing

g=GeneralizedHoneycombGraph[8,3]

RecognizeGraph@g

Bilateral

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

Circular

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

Planar

GraphData["CubicalGraph","Planar"]

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

IntegerCoordinates

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

Integral

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

MinimalIntegral

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

MinimalPlanarIntegral

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

MinimalCrossing

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

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

Circulant

GraphData["CubicalGraph","Circulant"]

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

Line graph

GraphData["CubicalGraph","Line"]

LineGraphQ[GraphData["CubicalGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["CubicalGraph"]]

Halin

GraphData["CubicalGraph","Halin"]

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

Rigid

GraphData["CubicalGraph","Rigid"]

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

Flexible

GraphData["CubicalGraph","Flexible"]

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

LCF

GraphData["CubicalGraph","LCF"]

GraphData["CubicalGraph","HamiltonianCycleCount"]

GraphData["CubicalGraph","LCFSignature"]

GraphData["CubicalGraph","LCFNotations"]

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

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

LCF compute all

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

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

lcf

LCFGraph@@@lcf//StyleGraphs

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

UnitDistance

GraphData["CubicalGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

UnitDistance construction

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

RecognizeGraph@g

g=CenterGraph@IndexGraph@

BilateralGraphEmbeddingQ@g

UnitDistanceGraphEmbeddingQ@g

gs=UnlabelGraph/@{,}

GraphEmbedding/@%//FullSimplify

Matchstick

GraphData["CubicalGraph","Matchstick"]

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

3D default

Graph3D[GraphData["CubicalGraph","Edges"]]

3D construction

g=CubicVertexTransitiveGraph[8,GraphLayout->"3DEmbedding"]

RecognizeGraph@g

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["CubicalGraph","Polyhedral"]

Stereoscopic projections

PolyhedronData[poly,"Orientations"]

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

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

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

Projections

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

{0, 0, 1}

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

{1, 1, 1}

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

{1, 0, 1}

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

{1, 0, 2}

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

{1, 2, 1}

PolyhedronProjectionGraph[PolyhedronData["Cube","Polyhedron"],{1,2,1},VertexLabels->"Name"]

{1, 2, 2}

PolyhedronProjectionGraph[PolyhedronData["Cube","Polyhedron"],{1,2,2},VertexLabels->"Name"]

v=GraphEmbedding[%];

{SquaredEuclideanDistance@@v[[{1,4}]],SquaredEuclideanDistance@@v[[{1,8}]]}

PolyhedronProjectionGraph[PolyhedronData["Cube","Polyhedron"],{x,1,1},VertexLabels->"Name"]

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

FullSimplify[SquaredEuclideanDistance@@v[[{1,4}]]-SquaredEuclideanDistance@@v[[{1,8}]],x>0]

Solve[((-2+4 x)/(2+(x^2)))==0,x]

{2, 1, 1}

PolyhedronProjectionGraph[PolyhedronData["Cube","Polyhedron"],{2,1,1},VertexLabels->"Name"]

Embedding constructions

MinimalPlanarIntegral

ShowLabeledGraph[g=Graph[List/@{{1,4},{4,3},{3,2},{2,1},{6,5},{5,8},{8,7},{7,6},{5,4},{1,6},{2,7},{3,8}},List/@((1/2)Csc[(π/4)]Join[
2Table[Through[{Cos,Sin}[2π (k+1/2)/4]],{k,4}],
Table[Through[{Cos,Sin}[2π( k-.04)/4]],{k,4}]])]]

Solve[Norm[(1/2)Csc[(π/4)](2Through[{Cos,Sin}[2π(4+1/2)/4]]-Through[{Cos,Sin}[2π (4-x)/4]])]==1,x]//FullSimplify

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

ShowLabeledGraph[g=Graph[List/@{{1,4},{4,3},{3,2},{2,1},{6,5},{5,8},{8,7},{7,6},{5,4},{1,6},{2,7},{3,8}},FullSimplify[List/@((1/2)Csc[(π/4)]Join[
2Table[Through[{Cos,Sin}[2π (k+1/2)/4]],{k,4}],
Table[Through[{Cos,Sin}[2π( k-((2 ArcCos[((3+(Sqrt[7]))/(4 (Sqrt[2])))])/π))/4]],{k,4}]])]]]

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

Vertices[g]

RecognizeGraph[g]

IntegralDrawing[g]

Insert[GraphData["CubicalGraph","Embeddings"],ToCommonEdges[g,"CubicalGraph"],8]

GetGraphData["CubicalGraph","File"]

UnitDistance

With[{x=1/(Sqrt[2])},ShowLabeledGraph[g=ChangeVertices[GraphData["CubicalGraph","Graphs"][[5]],{{0,1},{0,0},{-x,1+x},{-x,x},{1,1},{1,0},{1-x,1+x},{1-x,x}}]]]

Norm/@Subtract@@@(Edges[g]/.Thread[Range[8]->Vertices[g]])

GraphPlot[With[{x=1/(Sqrt[2])},g=ChangeVertices[GraphData["CubicalGraph","Graphs"][[5]],{{0,1},{0,0},{-x,1+x},{-x,x},{1,1},{1,0},{1-x,1+x},{1-x,x}}]],Method->None,ImageSize->175]

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

e=ToCommonEdges[g,"CubicalGraph"]//FullSimplify

Insert[GraphData["CubicalGraph","Embeddings"],e,6]

3D

Old

GraphData["CubicalGraph","Embeddings3D"]

New

v=Flatten[Outer[List,{0,1},{0,1},{0,1}],2]

e=Select[Subsets[v,{2}],Norm[#[[1]]-#[[2]]]==1&]/.Thread[v->Range[Length[v]]]

ToCommonEdges[Graph[List/@e,List/@v],Graph["CubicalGraph"]]

Knuth, V4f0, p. 14 "Crossed" cube

GetGraphData["CubicalGraph","File"]

ShowLabeledGraph[g=AddEdges[DeleteEdges[GraphData["CubicalGraph","Graphs"][[5]],{{1,2},{3,4},{7,8},{5,6}}],{{2,3},{1,4},{6,7},{5,8}}]]

RecognizeGraph[g]

Degenerate

ShowLabeledGraph[g1=AddEdges[ChangeVertices[gg=Graph[{"Grid",{2,4}}],Reverse/@Vertices[gg]],{{2,8},{1,7}}]]

RecognizeGraph[g1]

Append[Insert[GraphData["CubicalGraph","Embeddings"],ToCommonEdges[g,"CubicalGraph"],7],ToCommonEdges[g1,"CubicalGraph"]]

Double X

GraphData["CubicalGraph","Graph",{"Labeled","All"}][[-2]]

g=Graph[Range[8],UndirectedEdge@@@{{1,8},{2,3},{4,5},{6,7},{2,7},{3,6},{5,8},{1,4},{1,6},{2,5},{4,7},{3,8}},VertexCoordinates->CirclePoints[8],VertexLabels->"Name"]

RecognizeGraph[g]

Properties

Classes

GraphData[g,"Classes"]

Matrices

GraphicsRow[GraphMatrixPlot[GraphData["CubicalGraph"]]]

Properties

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

GraphData

GraphClassString

GraphClassString[g]