Heule Spindle

Author

Eric W. Weisstein
April 12, 2024

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

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

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

Figure

VertexColoredGraph[GraphData["HeuleSpindle"],EdgeStyle->Black]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["HeuleSpindle","StandardName"]

GraphData["HeuleSpindle","StandardNames"]

Primary

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

All

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

GraphicsRow[%,Dividers->All]

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["HeuleSpindle","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

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

RecognizeGraph@g

Degenerate

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

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

Configuration

GraphData["HeuleSpindle","Configuration"]

GraphData["HeuleSpindle","Graph","Configuration"]//StyleGraphs

Perspective

GraphData["HeuleSpindle","Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData["HeuleSpindle","Polyhedron"]

HoneycombToroidal construction

GraphData["HeuleSpindle","NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData["HeuleSpindle","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["HeuleSpindle","Graph","IGraph"]//StyleGraphs

Bilateral

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

Circular

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

Circular construction

GraphData["HeuleSpindle","Hamiltonian"]

GraphData["HeuleSpindle","HamiltonianCycleCount"]

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

circ=CircularEmbeddingFromHamiltonianCycle[GraphData["HeuleSpindle"],#]&/@hc

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph/@circ],
CircularCanonicalGraphEmbedding]]//Quiet//Timing

gs=bilat

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

Planar

GraphData["HeuleSpindle","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

(cn=CrossingNumber[GraphData["HeuleSpindle"],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HeuleSpindle"],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["HeuleSpindle"],TimeConstraint->5 3600])//AbsoluteTiming

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

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

Table[MinimalCrossingGraph[GraphData["HeuleSpindle"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union//Timing

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["HeuleSpindle","Circulant"]

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

Circulant construction

GraphData["HeuleSpindle","NotationRules","Circulant"]

(ci=CirculantIndices[GraphData["HeuleSpindle"]])//Timing

Complement graph

compl=GraphData["HeuleSpindle","ComplementGraph","Name"]

Line graph

GraphData["HeuleSpindle","Line"]

LineGraphQ[GraphData["HeuleSpindle"]]//Timing

RootGraph

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

RootGraph[GraphData["HeuleSpindle"]]

Halin

GraphData["HeuleSpindle","Halin"]

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

Rigid

GraphData["HeuleSpindle","Rigid"]

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

Flexible

GraphData["HeuleSpindle","Flexible"]

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

LCF

GraphData["HeuleSpindle","LCF"]

GraphData["HeuleSpindle","HamiltonianCycleCount"]

GraphData["HeuleSpindle","LCFSignature"]

GraphData["HeuleSpindle","LCFNotations"]

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

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

UnitDistance

GraphData["HeuleSpindle","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance construction

Solve[SquaredEuclideanDistance[{1/2,0},{((Sqrt[3])/2),h}]==3,h,PositiveReals]//FullSimplify

h=(Sqrt[(1/2) (4+(Sqrt[3]))]);
v={{-1/2,0},{1/2,0},{-((Sqrt[3])/2),h},{((Sqrt[3])/2),h}};
v=Join[v,UnitDistancePoints@@v[[{1,3}]],UnitDistancePoints@@v[[{2,4}]],UnitDistancePoints@@v[[{4,3}]]];
g=Graph[Range@Length@v,UnitEdges[v],VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

g=LabelGraph@

RecognizeGraph[EdgeAdd[g,1\[UndirectedEdge]3]]

Matchstick

GraphData["HeuleSpindle","Matchstick"]

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

3D default

Graph3D[GraphData["HeuleSpindle","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["HeuleSpindle","Polyhedral"]

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

Construction

Alex Soifer, The New Mathematical Coloring Book, page 697

v={{0,-(1/2)},{0,(1/2)},{((Sqrt[3])/2),0},{-((Sqrt[3])/2),0},{-1/2,(Sqrt[(1/2) (4-(Sqrt[3]))])},{1/2,(Sqrt[(1/2) (4-(Sqrt[3]))])},{(NumericalApproximation[Root, (RowDefault["-0.490", FEExpressionsNumericalApproximationElider]), Root[-1+12 #1-24 ((#1)^2)-72 ((#1)^3)+72 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.927", FEExpressionsNumericalApproximationElider]), Root[13+84 #1-96 ((#1)^2)-144 ((#1)^3)+144 ((#1)^4)&,3], ])},{(NumericalApproximation[Root, (RowDefault["0.124", FEExpressionsNumericalApproximationElider]), Root[-1+12 #1-24 ((#1)^2)-72 ((#1)^3)+72 ((#1)^4)&,2], ]),(NumericalApproximation[Root, (RowDefault["0.138", FEExpressionsNumericalApproximationElider]), Root[13-84 #1-96 ((#1)^2)+144 ((#1)^3)+144 ((#1)^4)&,3], ])},{(NumericalApproximation[Root, (RowDefault["0.490", FEExpressionsNumericalApproximationElider]), Root[-1-12 #1-24 ((#1)^2)+72 ((#1)^3)+72 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.927", FEExpressionsNumericalApproximationElider]), Root[13+84 #1-96 ((#1)^2)-144 ((#1)^3)+144 ((#1)^4)&,3], ])},{(NumericalApproximation[Root, (RowDefault["-0.124", FEExpressionsNumericalApproximationElider]), Root[-1-12 #1-24 ((#1)^2)+72 ((#1)^3)+72 ((#1)^4)&,3], ]),(NumericalApproximation[Root, (RowDefault["0.138", FEExpressionsNumericalApproximationElider]), Root[13-84 #1-96 ((#1)^2)+144 ((#1)^3)+144 ((#1)^4)&,3], ])}};

g=StyleGraphs@Graph[Range@Length@v,UnitEdges[v],VertexCoordinates->v]

RecognizeGraph@g

GraphData

GraphDataClassString

GraphDataClassString["HeuleSpindle"]

GraphDataString

<<MathWorld`Graphs`

file=OpenWrite["~/heule.m"]

WriteString[file,GraphDataString[g,
"StandardName"->"HeuleSpindle",
"Name"->"Heule spindle",
"Information"->"HeuleSpindle"
]]

Close[file]