Meringer Graph

Author

Eric W. Weisstein
October 30, 2023

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

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

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

Embeddings

<<MathWorld`Graphs`

Names

GraphData["MeringerGraph","StandardName"]

GraphData["MeringerGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["MeringerGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["MeringerGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

CrossingNumber[GraphData["MeringerGraph"],TimeConstraint->300]//AbsoluteTiming

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["MeringerGraph","Circulant"]

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

Complement graph

GraphData["MeringerGraph","ComplementGraph","Name"]

Line graph

GraphData["MeringerGraph","Line"]

LineGraphQ[GraphData["MeringerGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["MeringerGraph"]]

Halin

GraphData["MeringerGraph","Halin"]

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

Rigid

GraphData["MeringerGraph","Rigid"]

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

Flexible

GraphData["MeringerGraph","Flexible"]

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

LCF

GraphData["MeringerGraph","LCF"]

GraphData["MeringerGraph","HamiltonianCycleCount"]

GraphData["MeringerGraph","LCFSignature"]

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

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

LCF compute

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

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

(gs=Select[LCFGraph@@@DeleteCases[lcf,{_,1}],BilateralLCFEmbedding])//Timing

FileByteCount[file="/Volumes/GraphProperties/Properties/LCFNotations/MeringerGraph.m.gz"]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

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

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

g=LCFGraph@@lcf[[1]]

g=LCFGraph[{{-15,-12,-9},{-8,4,9},{-15,6,12},{-7,-4,8},{-12,5,14},{-15,-8,-4},{-7,7,11},{-15,-11,8},{-14,-6,12},{-5,4,7}},3,3]

UnitDistance

GraphData["MeringerGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

Select[%,UnitDistanceGraphEmbeddingQ]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["MeringerGraph","Matchstick"]

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

3D default

Graph3D[GraphData["MeringerGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["MeringerGraph","Polyhedral"]

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

Matrices

GraphicsRow[GraphMatrixPlot[GraphData["MeringerGraph"]]]

GraphData

GraphClassString

GraphClassString["MeringerGraph"]

Construction

Pisanksi

Import["/Volumes/Users/eww/Desktop/bridges-between-geometry-and.pdf",{"Pages",21}]

lines=;

Length[l=First/@Cases[lines,_Line,{1,∞}]]

Length[v=First/@Partition[Cases[lines,_Polygon,{4}]/.Polygon[x_]:>Mean[x],2]]

Graphics[{Line[newl={#[[1]]-.03(#[[2]]-#[[1]]),#[[2]]}&/@l],{Red,Circle[#,1]}&/@v}]

edges=Union[Sort/@Flatten/@Map[Nearest[Thread[v->Range[Length[v]]],#,1]&,newl,{2}]]

Length[edges]

ShowLabeledGraph[g=Graph[List/@edges,List/@v],VertexStyle->Disk[.02]]

M[g]

M[MakeSimple[g]]

Degrees[g]

g2=AddEdges[MakeSimple@g,{{6,7},{12,13},{18,19},{24,25},{1,30}}]

ShowGraph[g2,VertexStyle->Disk[.02],EdgeStyle->AbsoluteThickness[1]]

Degrees[g2]

RecognizeGraph[g2]

This embedding is wrong.  Try permuting pairs of edges connecting to the inner two rings?