Markström Graph

Author

Eric W. Weisstein
September 8, 2022

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

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

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

Embeddings

Names

GraphData["MarkstroemGraph","StandardName"]

GraphData["MarkstroemGraph","StandardNames"]

Primary

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

All

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

Bilateral

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

Circular

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

Planar

GraphData["MarkstroemGraph","Planar"]

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

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData["MarkstroemGraph"]]

Tally[ReverseSort[Length/@faces]]

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

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

Tutte embedding construction 9 #1

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 9 #2

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 5 #1

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Halin

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

LCF

GraphData["MarkstroemGraph","LCF"]

GraphData["MarkstroemGraph","HamiltonianCycleCount"]

GraphData["MarkstroemGraph","LCFSignature"]

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

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

LCF compute

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

Tally[(lcf=LCF[GraphData["MarkstroemGraph"],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["MarkstroemGraph","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

Default embedding

Import["http://upload.wikimedia.org/wikipedia/commons/f/f3/Markström-Graph.svg"]

Import["http://upload.wikimedia.org/wikipedia/commons/f/f3/Markström-Graph.svg","String"]

g8=SVGToGraph[Import["http://upload.wikimedia.org/wikipedia/commons/f/f3/Markström-Graph.svg","String"]]

List/@(Sort/@List@@@EdgeList[g8])

ShowLabeledGraph[g=AddEdges[Graph[List/@(Sort/@List@@@EdgeList[g8]),List/@PropertyValue[g8,VertexCoordinates]],Join[
Partition[{18,19,20,22,23,24,15,16,17},2,1,1],
Sequence@@Partition[#,2,1,1]&/@{{2,3,4},{5,6,7},{11,12,13},{8,9,10}},
{{9,21},{21,20},{1,17},{1,2},{13,14},{14,24}}
]
]]

ShowGraph[g]

V[g]

CubicQ[g]

PlanarQ[g]

Length[cyc=GraphCycles[CombinatoricaGraphToV8Graph@g]]//Timing

Tally[Sort[Length/@cyc]]

{{3,7},{5,3},{6,6},{7,3},{9,4},{10,18},{11,39},{12,64},{13,99},{14,141},{15,181},{16,228},{17,285},{18,320},{19,309},{20,258},{21,175},{22,84},{23,24},{24,3}}[[All,1]]

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

GraphPlot[RotateGraph[GraphData["MarkstroemGraph"],-.55]]

e[l__Integer]:=Sequence@@Partition[{l},2,1]

v=Join[CirclePoints[Csc[Pi/9]/2,9],CirclePoints[{1/5,-Pi/2},3],Sequence@@Table[CirclePoints[.8Through[{Cos,Sin}[2Pi i/3-Pi/2]],{1/5,2Pi i/3+Pi/2},3],{i,0,2}],
CirclePoints[{1.2,1.2},3]
];
ee=Sort[Sort/@{e[1,2,3,4,5,6,7,8,9,1,24,15,13,14,9],{14,15},{2,24},e[13,10,11,12,10],e[11,16,17,18,16],e[12,19,20,21,19],{3,17},e[8,23,7],{21,23},{6,20},e[18,22,5],{4,22}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@ee,VertexCoordinates->v,VertexLabels->"Name"]

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

RecognizeGraph[g]

3D default

Graph3D[GraphData["MarkstroemGraph","Edges"]]

3D All

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData["MarkstroemGraph","Polyhedron"]}]

Graphics3D[{Opacity[.5],Red,GraphData["MarkstroemGraph","Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["MarkstroemGraph"],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

GraphData

GraphDataString

Print[GraphDataString[g,
"StandardName"->"MarkstroemGraph",
"Name"->"Markström graph",
"Information"->"MarkstroemGraph",
Debug->True,
TimeConstraint->60
]]