Haugland Graphs

Author

Eric W. Weisstein
August 10, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/HauglandGraphs.nb.

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

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

Table

TextGrid[HauglandGraphs=Sort[{
GraphData[#,"V"],
GraphData[#,"EdgeCount"],
GraphData[#,"ChromaticNumber"],
GraphData[#,"TetrahedronCount"],
#
}&/@GraphData["*HauglandGraph*"]],
Dividers->All,
Alignment->{{{Decimal},Left,Left}}]

Figure

SystemOptions["GraphOptions"]

SetSystemOptions["GraphOptions"->"EdgeCountThreshold"->13000]

GraphicsRow[
VertexColoredGraph[GraphData[#,PlotLabel->GraphData[#,"Name"]]]&/@HauglandGraphs[[All,-1]],
BaseStyle->InsetBoxOptions->{BaseStyle->Directive[LightDarkSwitched@Black,14,Italic,FontFamily->"Times"]},
Dividers->All,
Alignment->Top
]

Embeddings

<<MathWorld`Graphs`

"HauglandGraph740"

Names

GraphData["HauglandGraph740","StandardName"]

GraphData["HauglandGraph740","StandardNames"]

HouseOfGraphs

hogid=GraphData["HauglandGraph740","NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData["HauglandGraph740","WikidataID"]

GraphData["HauglandGraph740","WikidataID","URL"]

Primary

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

All

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

CurvedEdge

GraphData["HauglandGraph740","Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["HauglandGraph740","Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData["HauglandGraph740"]]

Default embedding

g0=GraphPlot[Graph[GraphData["HauglandGraph740","VertexList"],GraphData["HauglandGraph740","Edges"]]]

Incidence

GraphData["HauglandGraph740","Incidence"]

Select[GraphData[All],GraphData[#,"LeviGraph","Name"]==="HauglandGraph740"&]

Configuration

GraphData["HauglandGraph740","Configuration"]

configurations=GraphData["HauglandGraph740","Graph","Configuration"]//StyleGraphs

GeneralizedPetersen

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

IGraph

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

CompleteKPartite

GraphData["HauglandGraph740","Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData["HauglandGraph740","Bipartite"]

GraphData["HauglandGraph740","Graph","Bipartite"]//StyleGraphs

Bilateral

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

Circular

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

Circular construction 1*^3 [3.8 s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph740"],1*^3][[All,All,1]]]//Timing

(hc1=MyFindHamiltonianCycle[GraphData["HauglandGraph740"]])//Timing

g=CircularEmbeddingFromHamiltonianCycle[GraphData["HauglandGraph740"],hc1[[1]]]

RecognizeGraph@g

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph740"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph740"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction 1*^4 [36 s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph740"],1*^4][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph740"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph740"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction 1*^5 [319 s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph740"],1*^5][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph740"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph740"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction 1*^6 [167 + 2745 s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph740"],1*^6][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph740"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph740"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction 1*^7 [ XX s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph740"],1*^6][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph740"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph740"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction All

GraphData["HauglandGraph740","Hamiltonian"]

True

GraphData["HauglandGraph740","HamiltonianCycles"]

GraphData["HauglandGraph740","HamiltonianCycleCount"]

GraphData["HauglandGraph740","LCF"]

GraphData["HauglandGraph740","LCFSignature"]

BilateralHamiltonianCycleQ[GraphData["HauglandGraph740"]]

FindBilateralHamiltonianCycle[GraphData["HauglandGraph740"]]

Length[hc=MyFindHamiltonianCycle[GraphData["HauglandGraph740"],All]]//Timing

gs=CircularEmbeddingFromHamiltonianCycle[GraphData["HauglandGraph740"],#]&/@Take[hc,1]

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph740"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph740"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Planar

GraphData["HauglandGraph740","Planar"]

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

MinimalCrossingNumber crossings.uos.de

CrossingNumber[GraphData["HauglandGraph740"],Method->"WebCompute"]//AbsoluteTiming

DateString[]

Quit

MinimalCrossingNumber: "EmbeddingScheme" -> 1

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 2

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

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

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

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

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

(cn=CrossingNumber[GraphData["HauglandGraph740"],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

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

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

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

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

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

(cn=CrossingNumber[GraphData["HauglandGraph740"],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData["HauglandGraph740","CN"]

(gs=GraphData["HauglandGraph740","Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData["HauglandGraph740","RCN"]

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

MinimalCrossing construction Tutte

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph740","V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData["HauglandGraph740","V"]],
_Integer?(LessEqualThan[GraphData["HauglandGraph740","V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph740","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph740","V"]])]==0&]

MinimalCrossing construction Random 1k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph740"],
1000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 5k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph740"],
5000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 20k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph740"],
20*^3,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 1k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData["HauglandGraph740"],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph740","V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph740","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData["HauglandGraph740"],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph740","V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph740","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData["HauglandGraph740",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["HauglandGraph740","Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData["HauglandGraph740",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["HauglandGraph740","Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData["HauglandGraph740"],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData["HauglandGraph740"],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData["HauglandGraph740","Circulant"]

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

Circulant construction

GraphData["HauglandGraph740","NotationRules","Circulant"]

(ci=CirculantIndices[GraphData["HauglandGraph740"]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData["HauglandGraph740","StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

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

Line graph

GraphData["HauglandGraph740","Line"]

LineGraphQ[GraphData["HauglandGraph740"]]//Timing

RootGraph

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

RootGraph[GraphData["HauglandGraph740"]]

Halin

GraphData["HauglandGraph740","Halin"]

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

Rigid

GraphData["HauglandGraph740","Rigid"]

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

Flexible

GraphData["HauglandGraph740","Flexible"]

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

Voltage

gs=GraphData["HauglandGraph740","Graph","Voltage"]//StyleGraphs

VoltageGraphNotation/@gs//Column

Voltage construction

gs=FindVoltageGraph[GraphData["HauglandGraph740"],20,TimeConstraint->60,Debug->True]

Length[gs]

LCF

GraphData["HauglandGraph740","LCF"]

GraphData["HauglandGraph740","HamiltonianCycleCount"]

GraphData["HauglandGraph740","LCFSignature"]

GraphData["HauglandGraph740","LCFNotations"]

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

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

UnitDistance

GraphData["HauglandGraph740","UnitDistance"]

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

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

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData["HauglandGraph740","EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData["HauglandGraph740","VertexList"],GraphData["HauglandGraph740","EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData["HauglandGraph740","Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g,Flatten[FindCoincidentVertices[g]]],
sym,
diff
}]

UnitDistance exact construction

inexact={};

(hs=FindUnitDistanceRingedGraph[#,Debug->True]&/@inexact)//Timing

(gs=ToAlgebraicCoordinates[#]&/@hs)//Timing

UnitDistanceGraphEmbeddingQ/@gs

GraphEmbedding/@gs

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName["HauglandGraph740",".m.gz"]}]]

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

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData["HauglandGraph740"],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData["HauglandGraph740"],"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{$Version,DateString[]}

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

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

Select[IndexGraph/@gs,!DegenerateGraphEmbeddingQ[#]&&GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]//Timing

Matchstick

GraphData["HauglandGraph740","Matchstick"]

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

3D default

Graph3D[GraphData["HauglandGraph740","Edges"]]

3D construction

3D All

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

3D UnitDistance construction Random

GraphData["HauglandGraph740","Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData["HauglandGraph740","VertexList"],
GraphData["HauglandGraph740","EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

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

3D Polyhedron

GraphData["HauglandGraph740","Polyhedral"]

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

"HauglandGraph1066"

Names

GraphData["HauglandGraph1066","StandardName"]

GraphData["HauglandGraph1066","StandardNames"]

HouseOfGraphs

hogid=GraphData["HauglandGraph1066","NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData["HauglandGraph1066","WikidataID"]

GraphData["HauglandGraph1066","WikidataID","URL"]

Primary

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

All

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

CurvedEdge

GraphData["HauglandGraph1066","Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["HauglandGraph1066","Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData["HauglandGraph1066"]]

Default embedding

g0=GraphPlot[Graph[GraphData["HauglandGraph1066","VertexList"],GraphData["HauglandGraph1066","Edges"]]]

Incidence

GraphData["HauglandGraph1066","Incidence"]

Select[GraphData[All],GraphData[#,"LeviGraph","Name"]==="HauglandGraph1066"&]

Configuration

GraphData["HauglandGraph1066","Configuration"]

configurations=GraphData["HauglandGraph1066","Graph","Configuration"]//StyleGraphs

GeneralizedPetersen

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

IGraph

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

CompleteKPartite

GraphData["HauglandGraph1066","Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData["HauglandGraph1066","Bipartite"]

GraphData["HauglandGraph1066","Graph","Bipartite"]//StyleGraphs

Bilateral

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

Circular

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

Circular construction 1

hc1=MyFindHamiltonianCycle[GraphData["HauglandGraph1066"]];//Timing

g=CircularEmbeddingFromHamiltonianCycle[GraphData["HauglandGraph1066"],hc1[[1]]]

RecognizeGraph@g

Circular construction 1*^4 [3 s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph1066"],1*^4][[All,All,1]]]//Timing

hc1=MyFindHamiltonianCycle[GraphData["HauglandGraph1066"]];//Timing

g=CircularEmbeddingFromHamiltonianCycle[GraphData["HauglandGraph1066"],hc1[[1]]]

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph1066"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph1066"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction 1*^5 [14 + 421 s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph1066"],1*^5][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph1066"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph1066"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction 1*^6 [ s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph1066"],1*^6][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph1066"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph1066"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction 1*^7[ s]

Length[hc=FindHamiltonianCycle[GraphData["HauglandGraph1066"],1*^7][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph1066"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph1066"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Circular construction All

GraphData["HauglandGraph1066","Hamiltonian"]

GraphData["HauglandGraph1066","HamiltonianCycles"]

GraphData["HauglandGraph1066","HamiltonianCycleCount"]

GraphData["HauglandGraph1066","LCF"]

GraphData["HauglandGraph1066","LCFSignature"]

BilateralHamiltonianCycleQ[GraphData["HauglandGraph1066"]]

FindBilateralHamiltonianCycle[GraphData["HauglandGraph1066"]]

Length[hc=MyFindHamiltonianCycle[GraphData["HauglandGraph1066"],All]]//Timing

gs=CircularEmbeddingFromHamiltonianCycle[GraphData["HauglandGraph1066"],#]&/@Take[hc,1]

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph1066"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph1066"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Planar

GraphData["HauglandGraph1066","Planar"]

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

MinimalCrossingNumber crossings.uos.de

CrossingNumber[GraphData["HauglandGraph1066"],Method->"WebCompute"]//AbsoluteTiming

DateString[]

Quit

MinimalCrossingNumber: "EmbeddingScheme" -> 1

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 2

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

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

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

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

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

(cn=CrossingNumber[GraphData["HauglandGraph1066"],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

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

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

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

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

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

(cn=CrossingNumber[GraphData["HauglandGraph1066"],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData["HauglandGraph1066","CN"]

(gs=GraphData["HauglandGraph1066","Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData["HauglandGraph1066","RCN"]

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

MinimalCrossing construction Tutte

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph1066","V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData["HauglandGraph1066","V"]],
_Integer?(LessEqualThan[GraphData["HauglandGraph1066","V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph1066","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph1066","V"]])]==0&]

MinimalCrossing construction Random 1k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph1066"],
1000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 5k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph1066"],
5000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 20k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph1066"],
20*^3,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 1k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData["HauglandGraph1066"],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph1066","V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph1066","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData["HauglandGraph1066"],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph1066","V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph1066","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData["HauglandGraph1066",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["HauglandGraph1066","Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData["HauglandGraph1066",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["HauglandGraph1066","Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData["HauglandGraph1066"],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData["HauglandGraph1066"],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData["HauglandGraph1066","Circulant"]

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

Circulant construction

GraphData["HauglandGraph1066","NotationRules","Circulant"]

(ci=CirculantIndices[GraphData["HauglandGraph1066"]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData["HauglandGraph1066","StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

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

Line graph

GraphData["HauglandGraph1066","Line"]

LineGraphQ[GraphData["HauglandGraph1066"]]//Timing

RootGraph

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

RootGraph[GraphData["HauglandGraph1066"]]

Halin

GraphData["HauglandGraph1066","Halin"]

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

Rigid

GraphData["HauglandGraph1066","Rigid"]

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

Flexible

GraphData["HauglandGraph1066","Flexible"]

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

Voltage

gs=GraphData["HauglandGraph1066","Graph","Voltage"]//StyleGraphs

VoltageGraphNotation/@gs//Column

Voltage construction

gs=FindVoltageGraph[GraphData["HauglandGraph1066"],20,TimeConstraint->60,Debug->True]

LCF

GraphData["HauglandGraph1066","LCF"]

GraphData["HauglandGraph1066","HamiltonianCycleCount"]

GraphData["HauglandGraph1066","LCFSignature"]

GraphData["HauglandGraph1066","LCFNotations"]

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

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

UnitDistance

GraphData["HauglandGraph1066","UnitDistance"]

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

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

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData["HauglandGraph1066","EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData["HauglandGraph1066","VertexList"],GraphData["HauglandGraph1066","EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData["HauglandGraph1066","Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g,Flatten[FindCoincidentVertices[g]]],
sym,
diff
}]

UnitDistance exact construction

inexact={};

(hs=FindUnitDistanceRingedGraph[#,Debug->True]&/@inexact)//Timing

(gs=ToAlgebraicCoordinates[#]&/@hs)//Timing

UnitDistanceGraphEmbeddingQ/@gs

GraphEmbedding/@gs

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName["HauglandGraph1066",".m.gz"]}]]

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

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData["HauglandGraph1066"],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData["HauglandGraph1066"],"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{$Version,DateString[]}

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

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

Select[IndexGraph/@gs,!DegenerateGraphEmbeddingQ[#]&&GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]//Timing

Matchstick

GraphData["HauglandGraph1066","Matchstick"]

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

3D default

Graph3D[GraphData["HauglandGraph1066","Edges"]]

3D construction

3D All

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

3D UnitDistance construction Random

GraphData["HauglandGraph1066","Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData["HauglandGraph1066","VertexList"],
GraphData["HauglandGraph1066","EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

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

3D Polyhedron

GraphData["HauglandGraph1066","Polyhedral"]

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

"HauglandGraph2131"

SetSystemOptions["GraphOptions"->"EdgeCountThreshold"->13000]

Names

GraphData["HauglandGraph2131","StandardName"]

GraphData["HauglandGraph2131","StandardNames"]

HouseOfGraphs

hogid=GraphData["HauglandGraph2131","NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData["HauglandGraph2131","WikidataID"]

GraphData["HauglandGraph2131","WikidataID","URL"]

Primary

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

All

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

CurvedEdge

GraphData["HauglandGraph2131","Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["HauglandGraph2131","Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData["HauglandGraph2131"]]

Default embedding

g0=GraphPlot[Graph[GraphData["HauglandGraph2131","VertexList"],GraphData["HauglandGraph2131","Edges"]]]

Incidence

GraphData["HauglandGraph2131","Incidence"]

Select[GraphData[All],GraphData[#,"LeviGraph","Name"]==="HauglandGraph2131"&]

Configuration

GraphData["HauglandGraph2131","Configuration"]

configurations=GraphData["HauglandGraph2131","Graph","Configuration"]//StyleGraphs

GeneralizedPetersen

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

IGraph

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

CompleteKPartite

GraphData["HauglandGraph2131","Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData["HauglandGraph2131","Bipartite"]

GraphData["HauglandGraph2131","Graph","Bipartite"]//StyleGraphs

Bilateral

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

Circular

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

Circular construction 1

(hc1=Flatten@MyFindHamiltonianCycle[GraphData["HauglandGraph2131"],Debug->True])//AbsoluteTiming

HamiltonianCycleQ[GraphData["HauglandGraph2131"],hc1,Debug->True]

l={
{"HauglandGraph2131",{0,hc1}}
};

g=CircularEmbeddingFromHamiltonianCycle[GraphData["HauglandGraph2131"],hc1]

RecognizeGraph@g

Circular construction All

GraphData["HauglandGraph2131","Hamiltonian"]

GraphData["HauglandGraph2131","HamiltonianCycles"]

GraphData["HauglandGraph2131","HamiltonianCycleCount"]

GraphData["HauglandGraph2131","LCF"]

GraphData["HauglandGraph2131","LCFSignature"]

BilateralHamiltonianCycleQ[GraphData["HauglandGraph2131"]]

FindBilateralHamiltonianCycle[GraphData["HauglandGraph2131"]]

Length[hc=MyFindHamiltonianCycle[GraphData["HauglandGraph2131"],All]]//Timing

gs=CircularEmbeddingFromHamiltonianCycle[GraphData["HauglandGraph2131"],#]&/@Take[hc,1]

Length[hcsym=SymmetricHamiltonianCycles[GraphData["HauglandGraph2131"],hc,ProgressReporting->True]]//Timing

groups=GroupBy[SymmetricHamiltonianCycleGraph[GraphData["HauglandGraph2131"],#]&/@hcsym,GraphSymmetryGroup]

gs=Join@@Values[groups]

Planar

GraphData["HauglandGraph2131","Planar"]

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

MinimalCrossingNumber crossings.uos.de

CrossingNumber[GraphData["HauglandGraph2131"],Method->"WebCompute"]//AbsoluteTiming

DateString[]

Quit

MinimalCrossingNumber: "EmbeddingScheme" -> 1

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 2

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

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

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

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

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

(cn=CrossingNumber[GraphData["HauglandGraph2131"],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

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

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

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

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

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

(cn=CrossingNumber[GraphData["HauglandGraph2131"],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData["HauglandGraph2131","CN"]

(gs=GraphData["HauglandGraph2131","Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData["HauglandGraph2131","RCN"]

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

MinimalCrossing construction Tutte

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph2131","V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData["HauglandGraph2131","V"]],
_Integer?(LessEqualThan[GraphData["HauglandGraph2131","V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph2131","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph2131","V"]])]==0&]

MinimalCrossing construction Random 1k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph2131"],
1000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 5k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph2131"],
5000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 20k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData["HauglandGraph2131"],
20*^3,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

Take[diagrams1,UpTo[10]]

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 1k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData["HauglandGraph2131"],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph2131","V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph2131","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData["HauglandGraph2131"],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData["HauglandGraph2131","V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData["HauglandGraph2131","V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData["HauglandGraph2131",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["HauglandGraph2131","Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData["HauglandGraph2131",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["HauglandGraph2131","Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData["HauglandGraph2131"],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData["HauglandGraph2131"],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData["HauglandGraph2131","Circulant"]

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

Circulant construction

GraphData["HauglandGraph2131","NotationRules","Circulant"]

(ci=CirculantIndices[GraphData["HauglandGraph2131"]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData["HauglandGraph2131","StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

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

Line graph

GraphData["HauglandGraph2131","Line"]

LineGraphQ[GraphData["HauglandGraph2131"]]//Timing

RootGraph

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

RootGraph[GraphData["HauglandGraph2131"]]

Halin

GraphData["HauglandGraph2131","Halin"]

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

Rigid

GraphData["HauglandGraph2131","Rigid"]

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

Flexible

GraphData["HauglandGraph2131","Flexible"]

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

Voltage

gs=GraphData["HauglandGraph2131","Graph","Voltage"]//StyleGraphs

VoltageGraphNotation/@gs//Column

Voltage construction

gs=FindVoltageGraph[GraphData["HauglandGraph2131"],20,TimeConstraint->60,Debug->True]

Length[gs]

LCF

GraphData["HauglandGraph2131","LCF"]

GraphData["HauglandGraph2131","HamiltonianCycleCount"]

GraphData["HauglandGraph2131","LCFSignature"]

GraphData["HauglandGraph2131","LCFNotations"]

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

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

UnitDistance

GraphData["HauglandGraph2131","UnitDistance"]

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

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData["HauglandGraph2131","EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData["HauglandGraph2131","VertexList"],GraphData["HauglandGraph2131","EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData["HauglandGraph2131","Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g,Flatten[FindCoincidentVertices[g]]],
sym,
diff
}]

UnitDistance exact construction

inexact={};

(hs=FindUnitDistanceRingedGraph[#,Debug->True]&/@inexact)//Timing

(gs=ToAlgebraicCoordinates[#]&/@hs)//Timing

UnitDistanceGraphEmbeddingQ/@gs

GraphEmbedding/@gs

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName["HauglandGraph2131",".m.gz"]}]]

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

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData["HauglandGraph2131"],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData["HauglandGraph2131"],"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData["HauglandGraph2131","Matchstick"]

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

3D default

Graph3D[GraphData["HauglandGraph2131","Edges"]]

3D construction

3D All

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

3D UnitDistance construction Random

GraphData["HauglandGraph2131","Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData["HauglandGraph2131","VertexList"],
GraphData["HauglandGraph2131","EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

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

3D Polyhedron

GraphData["HauglandGraph2131","Polyhedral"]

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

Construction

Unit vectors

Exact coordinate constructions of the three unit-distance graphs denoted G1, G2, and G3 by Haugland (2026). They have 740, 1066, and 2131 vertices, respectively. The construction follows arXiv:2608.04542v2. No approximate number is used to define a vertex coordinate.

The 84 unit vectors are recovered as directed edges of Haugland's 21-vertex graph H, avoiding inverse trigonometric expressions and retaining exact algebraic coordinates.

alpha=(1/(Sin[((2 π)/7)]));beta=(1/(Sin[((4 π)/7)]));gamma=(1/(Sin[((8 π)/7)]));p[j_]:=(1/2) (-gamma) {Cos[((2 π j)/7)+(π/2)],Sin[((2 π j)/7)+(π/2)]};q[j_]:=(1/2) alpha {Cos[((2 π j)/7)+(π/6)],Sin[((2 π j)/7)+(π/6)]};r[j_]:=(1/2) beta {Cos[((2 π j)/7)+((5 π)/6)],Sin[((2 π j)/7)+((5 π)/6)]};vectorRules=Flatten[Table[{12 j->p[Mod[4+j,7]]-p[Mod[3+j,7]],1+12 j->q[j]-r[j],2+12 j->r[Mod[4+j,7]]-r[Mod[1+j,7]],3+12 j->p[Mod[6+j,7]]-r[Mod[6+j,7]],4+12 j->q[Mod[6+j,7]]-q[Mod[4+j,7]],5+12 j->p[Mod[5+j,7]]-q[Mod[5+j,7]],6+12 j->p[j]-p[Mod[1+j,7]],7+12 j->r[Mod[4+j,7]]-q[Mod[4+j,7]],8+12 j->r[Mod[5+j,7]]-r[Mod[1+j,7]],9+12 j->r[Mod[3+j,7]]-p[Mod[3+j,7]],10+12 j->q[Mod[1+j,7]]-q[Mod[3+j,7]],11+12 j->q[Mod[2+j,7]]-p[Mod[2+j,7]]},{j,0,6}],1];
unitVectors=Association[vectorRules];

N[Norm/@Values[unitVectors]]

And@@(N[#.#]==1.&)/@Values[unitVectors]//Timing

And@@(RootReduce[#.#-1]===0&)/@Values[unitVectors]//Timing

740-vertex core

The following 231 paths are transcribed from Appendix A of Haugland (2026). Their exact partial sums cover every vertex of G1. The numerical key is used only to recognize equal exact expressions; the separation bounds proved in the paper make this identification unambiguous.

paths={{2,23,28,69,33},{7,19,28,69,38},{10,31,68,37,14},{33,28,20,66,3},{37,28,25,74,3},{40,17,53,7,14},{42,23,14,65,14},{44,7,28,78,25},{46,7,14,44,13},{47,83,37,14,16},{48,28,0,6,28},{50,19,17,77,28},{50,28,17,77,19},{53,32,83,14,22},{53,40,7,14,17},{54,17,28,80,23},{62,83,28,25,23},{64,7,33,31,14},{66,3,20,33,28},{69,19,28,38,7},{69,33,28,2,23},{69,34,17,7,33},{69,38,19,7,28},{72,39,14,33,12},{77,10,17,39,37},{77,28,17,50,19},{77,46,28,10,23},{78,7,44,28,25},{80,28,17,54,23},{82,19,58,28,25},{82,28,26,54,14},{83,23,28,62,25},{83,36,48,14,17},{0,21,83,33,28,52},{2,14,47,30,83,37},{2,33,14,12,58,39},{2,47,30,37,14,83},{3,20,37,33,60,7},{3,25,4,28,60,37},{3,34,14,31,47,80},{3,36,8,69,34,28},{3,37,13,69,39,22},{3,39,28,66,29,8},{4,14,49,28,46,7},{4,17,25,28,69,48},{4,25,51,14,53,17},{4,39,28,32,69,8},{6,14,37,68,42,19},{6,19,28,7,57,44},{6,28,57,44,7,19},{7,14,78,50,33,31},{7,17,44,5,54,28},{7,28,64,8,44,25},{7,31,69,3,34,33},{7,33,14,78,31,50},{8,14,53,25,58,21},{8,21,0,58,39,28},{8,28,73,39,37,6},{8,29,66,28,39,3},{10,17,23,77,51,39},{10,23,14,51,68,31},{10,28,37,68,0,31},{10,37,60,7,14,38},{12,25,68,19,28,58},{13,0,39,37,28,76},{13,14,51,30,61,14},{14,17,7,54,53,26},{14,22,69,42,3,34},{14,59,82,28,40,17},{14,79,18,37,28,60},{16,69,47,14,37,13},{17,19,36,53,14,72},{18,69,28,33,71,20},{19,52,21,14,47,83},{20,14,47,19,51,82},{20,71,33,28,69,18},{21,14,38,51,14,74},{22,69,14,13,53,32},{23,60,32,33,83,7},{24,7,28,52,19,69},{25,23,76,48,83,28},{25,83,47,19,82,37},{26,14,39,72,33,82},{28,9,28,66,3,40},{28,16,83,0,47,37},{28,17,40,7,53,0},{28,18,71,69,33,20},{28,24,75,14,66,33},{28,25,12,77,64,33},{28,63,18,16,69,28},{28,73,63,12,28,25},{30,77,28,17,43,80},{31,0,33,28,7,64},{31,14,48,24,69,7},{32,1,54,83,28,23},{32,14,13,69,22,53},{33,12,83,32,77,39},{33,14,66,38,83,21},{33,17,66,18,83,39},{33,20,7,67,46,14},{33,21,14,31,64,77},{33,23,21,77,46,83},{33,23,80,17,72,39},{33,28,82,11,69,34},{33,31,50,14,7,78},{33,37,83,68,25,12},{34,17,15,51,14,68},{34,28,17,80,47,0},{34,33,3,6,28,66},{36,17,28,0,83,48},{37,6,33,68,5,28},{37,13,14,60,3,36},{37,14,74,3,42,25},{37,17,54,9,80,28},{37,24,39,80,77,17},{37,25,68,15,78,28},{37,28,60,4,3,25},{37,83,14,30,47,2},{38,7,14,60,37,10},{38,21,66,14,83,33},{39,7,78,6,37,33},{39,12,28,54,81,14},{39,13,14,51,76,23},{39,14,18,74,17,51},{39,17,14,18,74,51},{39,18,14,8,69,42},{39,22,69,13,3,37},{39,37,14,6,62,13},{40,3,53,14,31,7},{40,7,3,31,53,14},{40,28,3,82,45,14},{42,3,34,14,69,22},{42,19,82,14,58,25},{42,23,25,14,62,83},{42,25,3,14,74,37},{42,77,46,23,10,14},{44,13,21,14,77,46},{44,14,21,77,13,46},{44,25,83,7,48,17},{44,28,5,54,7,17},{44,57,7,28,19,6},{46,13,77,21,14,44},{46,28,7,44,0,13},{46,77,14,10,23,42},{46,83,77,21,33,23},{47,0,80,28,34,17},{47,14,21,45,78,14},{47,34,3,31,80,14},{47,37,14,13,69,16},{47,80,31,3,14,34},{48,17,69,13,14,36},{48,83,28,76,25,23},{50,14,31,13,14,62},{50,17,14,48,83,22},{50,31,78,7,33,14},{51,0,17,28,39,4},{51,14,39,12,77,24},{51,17,0,39,4,28},{51,20,0,33,82,28},{51,39,77,23,10,17},{51,82,19,47,14,20},{52,33,28,83,0,21},{53,0,32,83,28,22},{53,7,26,14,17,54},{53,14,72,36,17,19},{53,17,14,51,25,4},{53,17,19,25,58,7},{53,22,69,32,13,14},{53,26,25,28,77,3},{54,14,17,26,53,7},{54,14,81,12,39,28},{54,23,28,83,1,32},{54,28,1,32,83,23},{58,7,25,78,28,30},{58,14,25,53,8,21},{58,14,41,28,83,16},{58,21,25,53,14,8},{58,25,42,14,82,19},{58,28,39,5,3,22},{58,39,12,14,2,33},{60,7,44,13,32,14},{60,28,23,32,10,77},{62,13,6,39,37,14},{62,13,39,37,6,14},{62,14,83,20,41,28},{64,77,31,14,21,33},{66,14,49,28,7,24},{66,28,29,17,68,19},{66,33,83,18,39,17},{68,14,51,23,10,31},{68,15,78,28,37,25},{68,19,17,37,83,36},{68,31,0,37,10,28},{69,7,24,52,28,19},{69,8,34,3,36,28},{69,23,16,28,72,33},{69,28,48,22,3,20},{69,42,8,14,39,18},{69,48,31,24,7,14},{72,19,44,17,39,7},{72,28,33,16,69,23},{72,39,19,76,28,23},{74,14,21,54,37,17},{74,37,14,25,42,3},{74,51,18,17,39,14},{76,23,39,19,72,28},{76,37,28,0,39,13},{77,3,42,39,14,26},{77,17,80,39,37,24},{77,19,64,28,36,17},{77,24,51,14,39,12},{77,28,24,69,37,16},{77,32,42,14,83,30},{77,39,12,40,3,28},{78,25,28,37,15,68},{80,14,31,3,34,47},{80,17,39,63,28,18},{80,23,46,13,47,14},{80,43,17,28,77,30},{82,14,19,47,51,20},{82,28,25,44,72,19},{82,33,72,14,39,26},{82,37,19,47,83,25},{83,7,33,32,23,60},{83,16,28,44,77,32},{83,21,14,47,52,19},{83,22,48,14,50,17},{83,28,22,41,64,14},{83,30,14,32,77,42},{83,33,14,66,38,21},{83,39,18,66,33,17}};

coordinateKey[point_]:=Round[N[point],(1/(10^10))];
g1Coordinates=DeleteDuplicatesBy[Flatten[(FoldList[Plus,{0,0},Lookup[unitVectors,#1]]&)/@paths,1],coordinateKey];

{
Length[paths],
Counts[Length/@paths],
Length[g1Coordinates],
FreeQ[g1Coordinates,_Real]
}

<<MathWorld`Graphs`

Length[edges740=UnitEdges[g1Coordinates]]//Timing

HauglandGraph740=Graph[
Range@Length@g1Coordinates,
edges740,
VertexCoordinates->g1Coordinates
]

IsomorphicSubgraphQ[GraphData["MoserSpindle"],HauglandGraph740]//Timing

VertexChromaticNumber[HauglandGraph740]

1066- and 2131-vertex graphs

Two exact 60-degree rotations and translations produce G2. A final exact rotation with cosine 7/8 produces G3.

rotation1=(1/2) {{1,-(Sqrt[3])},{(Sqrt[3]),1}};
rotation2=(1/2) {{1,(Sqrt[3])},{-(Sqrt[3]),1}};v1Coordinates=(#1.rotation1+{-1,0}&)/@g1Coordinates;v2Coordinates=(#1.rotation2+{1,0}&)/@g1Coordinates;g2Coordinates=DeleteDuplicatesBy[Join[v1Coordinates,v2Coordinates],coordinateKey];spindleRotation=(1/8) {{7,(Sqrt[15])},{-(Sqrt[15]),7}};g3Coordinates=DeleteDuplicatesBy[Join[g2Coordinates,((#1+{1,0}).spindleRotation+{-1,0}&)/@g2Coordinates],coordinateKey];

{
Length[g1Coordinates],
Length[g2Coordinates],
Length[g3Coordinates],
FreeQ[g3Coordinates,_Real]
}

Numerical distances identify candidate pairs, after which RootReduce certifies every retained squared distance exactly. The three graphs have order-size pairs (740, 3985), (1066, 6264), and (2131, 12530). The chromatic number 5 and absence of a Moser spindle for the 2131-vertex graph are established in Haugland (2026), rather than inferred here with heuristic coloring functions.

Length[edges1066=UnitEdges[g2Coordinates]]//Timing

HauglandGraph1066=Graph[
Range@Length@g2Coordinates,
edges1066,
VertexCoordinates->g2Coordinates
]

Length[edges2131=UnitEdges[g3Coordinates,Tolerance->1*^-9]]//Timing

HauglandGraph2131=Graph[
Range@Length@g3Coordinates,
edges2131,
VertexCoordinates->g3Coordinates
]

Reference

Haugland, J. K. A Moser-Spindle-Free 5-Chromatic Unit Distance Graph on 2131 Vertices in the Plane. 5 Aug 2026. https://arxiv.org/abs/2608.04542

GraphData

GraphDataString

<<MathWorld`Graphs`

haugland={,,};

UnitDistanceGraphEmbeddingQ/@haugland

file=OpenAppend["~/haugland-graphs.m"]

With[{n=ToString@VertexCount[#]},
WriteString[
file,
GraphDataString[
#,
"StandardName"->"HauglandGraph"<>n,
"Name"->"Haugland graph "<>n,
"Information"->"HauglandGraphs",
"Skip"->{"PinnacleSets"}
]]
]&/@haugland[[{-1}]];

Close[file]