Twinplex Graph

Author

Eric W. Weisstein
April 17, 2023

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

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

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

Embeddings

<<MathWorld`Graphs`

GraphData["TwinplexGraph","StandardName"]

Construction from Robertson et al. 2019

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

r=RecognizeGraph[twinplex]

rcn=RectilinearCrossingCount[twinplex]

vs=ToCommonEdges[twinplex,GraphData[r]]

Construction from Norine and Thomas (b) [erroneously claimed to be twinplex, but is actually another copy of cubeplex]

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

Construction from Fischer and Little (Subscript[Γ, 2]) [LCF]

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

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

RecognizeGraph[gamma2]

LCF[gamma2,All]

Construction from Mohar and Thomassen 2001

Using the numbering of Glover et al. 1979 for projective planar forbidden topological minors

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

RecognizeGraph@g

Construction from Glover et al. 1979

H. Glover, J. Huneke, and C. S. Wang, 103 graphs that are irreducible for the projective plane. J. Combinatorial Theory Ser. B 27 3 (1979).

v={{0,0},{1,0},{3/2,0},{2,0},{2,1},{3/2,1},{1,1},{1/2,1},{0,1},{0,1/2},{1/2,1/2},{3/2,1/2}};
g0=Graph[Range[Length[v]],Sort[Sort/@(UndirectedEdge@@@{e[1,2,3,4,5,6,7,8,9,10,1],e[10,11,12,3],{12,8},{11,6},
Sequence@@(curvededges={{2,7},{1,5},{4,9}})})],VertexCoordinates->v,VertexLabels->Automatic]

DegenerateGraphEmbeddingTypes@g0

{3,#}&/@curvededges

g=CurvedEdges[g0,{{3,{2,7}},{3,{1,5}},{3,{4,9}}}]

RecognizeGraph[g]

{CircuitRank[g],VertexCount[g],ReverseSort@VertexDegree[g]}

ProjectivePlanarGraphQ[g,Debug->True]//Timing

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["TwinplexGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

GraphPlot[GraphData["TwinplexGraph","Edges"],GraphLayout->"HighDimensionalEmbedding"]

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

RecognizeGraph@g

Degenerate

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

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

Bilateral

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

Circular

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

Circular construction

Length[hc=FindHamiltonianCycle[GraphData["TwinplexGraph"],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData["TwinplexGraph"],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

gs=bilat

Length[quad=DeleteDuplicatesBy[Union@Select[bilat,BilateralGraphEmbeddingQ[#,Axis->"X"]&],CircularCanonicalGraphEmbedding[#,4]&]]

Planar

GraphData["TwinplexGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

g=MinimalCrossingGraph[GraphData["TwinplexGraph"],"CrossingNumber"->2]

quads=AdjacencyList[g,#]&/@{13,14}

{{2,3,8,5},{4,11,9,7}};

Pairs[l_]:=Module[{twos={l[[1]],#}&/@Rest[l]},
{#,Complement[l,#]}&/@twos
]

p1=Pairs[{2,3,8,5}]

p2=Pairs[{4,11,9,7}]

combs=Flatten[#,1]&/@Flatten[Outer[List,p1,p2,1],1]

Length[combs]

g0=Graph[Range[12],Select[EdgeList[g],FreeQ[#,13|14]&],VertexCoordinates->Take[GraphEmbedding[g],12]]

gs=EdgeAdd[g0,UndirectedEdge@@@#]&/@combs

GraphPlot/@Pick[gs,IsomorphicGraphQ[#,GraphData["TwinplexGraph"]]&/@gs]

{}

Length[v]

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

r=RecognizeGraph[g]

rcn=RectilinearCrossingCount@g

vs=ToCommonEdges[g,GraphData[r]]

Circulant

GraphData["TwinplexGraph","Circulant"]

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

Line graph

GraphData["TwinplexGraph","Line"]

LineGraphQ[GraphData["TwinplexGraph"]]//Timing

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

LineGraphRootGraph[GraphData["TwinplexGraph"]]

Halin

GraphData["TwinplexGraph","Halin"]

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

Rigid

GraphData["TwinplexGraph","Rigid"]

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

Flexible

GraphData["TwinplexGraph","Flexible"]

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

LCF

GraphData["TwinplexGraph","LCFSignature"]

GraphData["TwinplexGraph","LCFNotations"]

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

LCF compute all

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

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

BilateralLCFGraph@@@lcf

UnitDistance

GraphData["TwinplexGraph","UnitDistance"]

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

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

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

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

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

UnitDistance construction

g=RotateGraph[SetProperty[,VertexLabels->Automatic],{9,12}]

None of this shape:

RotateGraph[LabelGraph[],{4,10}]

v={{-a,b},{-e,f},{0,h+1},{-1/2,0},{-c,d},{-x,y},{0,h},{c,d},{x,y},{1/2,0},{a,b},{e,f}};
ee=GraphData["TwinplexGraph","Edges"];
eqn=UnitEdgeEquations[v,ee]//FullSimplify//Union

var=Variables[Subtract@@@eqn]

Length/@{eqn,var}

(soln=Solve[eqn,var,Reals])//Timing

gs=Graph[Range[12],ee,VertexCoordinates->(v/.#)]&/@nsoln

DegenerateGraphEmbeddingTypes/@gs

v={{-a,b},{-e+de,f},{0,h+1},{-1/2,0},{-c,d},{-x,y},{0,h},{c,d},{x,y},{1/2,0},{a,b},{e+de,f}};
ee=GraphData["TwinplexGraph","Edges"];
eqn=UnitEdgeEquations[v,ee]//FullSimplify//Union

var=Variables[Subtract@@@eqn]

soln=Select[Solve[eqn,var,Reals],(de/.#)>0&]

v={{-a,b},{-e,f-df},{0,h+1},{-1/2,0},{-c,d},{-x,y},{0,h},{c,d},{x,y},{1/2,0},{a,b},{e,f+df}};
ee=GraphData["TwinplexGraph","Edges"];
eqn=UnitEdgeEquations[v,ee]//FullSimplify//Union

var=Variables[Subtract@@@eqn]

soln=Select[Solve[eqn,var,Reals],(df/.#)>0&]

gs=Graph[Range[12],ee,VertexCoordinates->(v/.#)]&/@soln

g=RotateGraph[LabelGraph[],{6,12}]

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

gs={,}

Matchstick

GraphData["TwinplexGraph","Matchstick"]

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

3D default

Graph3D[GraphData["TwinplexGraph","Edges"]]

v

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

RecognizeGraph@g

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["TwinplexGraph","Polyhedral"]

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

Properties

CrossingNumber

GraphData["TwinplexGraph","CrossingNumber"]

CrossingNumber[GraphData["TwinplexGraph"]]

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

Girth

GirthByCycles[GraphData["TwinplexGraph"]]

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

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

RectilinearCrossingNumber

GraphData["TwinplexGraph","RectilinearCrossingNumber"]

GraphData["TwinplexGraph","Graph","MinimalRectilinearCrossing"]

GraphData["TwinplexGraph","Graph","MinimalRectilinearCrossing"]//StyleGraphs

VertexCount

VertexCount[GraphData["TwinplexGraph"]]