Double Star Snark

Author

Eric W. Weisstein
June 19, 2023

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

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

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

Embeddings

Names

GraphData["DoubleStarSnark","StandardName"]

GraphData["DoubleStarSnark","StandardNames"]

Primary

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

Construction from Read and Wilson

p. 281

Import["/Users/eww/Downloads/Untitled.pdf"][[-1]]

With[{q=Pi/15,r1=6/12,r2=5/12},
v=Join[c1=CirclePoints[{1,Pi/2+q},5],c2=CirclePoints[{1,Pi/2-q},5],c3=Mean/@Transpose[{c1,c2}]];
v=Join[v,Sequence@@({#-r1#3,#2-r1#3,#3-r2#3}&@@@Transpose[{c1,c2,c3}])];
];
g=Graph[Range@Length@v,UndirectedEdge@@@{e[10,15,5,6,11,1,7,12,2,8,13,3,9,14,4,10],{12,21},{13,24},{14,27},{30,15},{11,18},{2,6},{7,3},{1,10},{5,9},{4,8},e[26,27,25,17,18,16,23,24,22,29,30,28,20,21,19,26,16],{17,22},{23,28},{20,25},{19,29}},VertexCoordinates->v,VertexLabels->Automatic]

With[{q=Pi/12,r=1/4},
v=Join[c1=CirclePoints[{1,Pi/2+q},5],c2=CirclePoints[{1,Pi/2-q},5],c3=Mean/@Transpose[{c1,c2}]];
v=Join[v,Sequence@@({#-r#3,#2-r#3,#3-r#3}&@@@Transpose[{c1,c2,c3}])];
];
g=Graph[Range@Length@v,UndirectedEdge@@@{e[10,15,5,6,11,1,7,12,2,8,13,3,9,14,4,10],{12,21},{13,24},{14,27},{30,15},{11,18},{2,6},{7,3},{1,10},{5,9},{4,8},e[26,27,25,17,18,16,23,24,22,29,30,28,20,21,19,26,16],{17,22},{23,28},{20,25},{19,29}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["DoubleStarSnark","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["DoubleStarSnark","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

(g=MinimalCrossingGraph[GraphData["DoubleStarSnark"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["DoubleStarSnark","Circulant"]

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

Line graph

GraphData["DoubleStarSnark","Line"]

LineGraphQ[GraphData["DoubleStarSnark"]]//Timing

RootGraph

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

RootGraph[GraphData["DoubleStarSnark"]]

Halin

GraphData["DoubleStarSnark","Halin"]

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

Rigid

GraphData["DoubleStarSnark","Rigid"]

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

Flexible

GraphData["DoubleStarSnark","Flexible"]

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

LCF

GraphData["DoubleStarSnark","LCF"]

GraphData["DoubleStarSnark","HamiltonianCycleCount"]

GraphData["DoubleStarSnark","LCFSignature"]

GraphData["DoubleStarSnark","LCFNotations"]

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

UnitDistance

GraphData["DoubleStarSnark","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["DoubleStarSnark","Matchstick"]

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

3D default

Graph3D[GraphData["DoubleStarSnark","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["DoubleStarSnark","Polyhedral"]