Thomassen Graphs

Author

Eric W. Weisstein
May 27, 2024

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

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

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

Graphic

thomassen=SortBy[GraphData["Thomassen*"],GraphData[#,"V"]&]

GraphicsGrid[Partition[Show[StyleGraphs[GraphData[#]],PlotLabel->TextCell[Style[GraphData[#,"Name"],Directive[14,Italic,Black,FontFamily->"Times"]],PageWidth->170,TextAlignment->Center]]&/@thomassen,UpTo[4]],Alignment->Center,ImageSize->700,Dividers->All]

Hypohamiltonian

hypohamiltonian=Select[thomassen,GraphData[#,"Hypohamiltonian"]&]

GraphicsGrid[Partition[Show[StyleGraphs[GraphData[#]],PlotLabel->TextCell[Style[GraphData[#,"Name"],Directive[14,Italic,Black,FontFamily->"Times"]],PageWidth->170,TextAlignment->Center]]&/@hypohamiltonian,UpTo[3]],Alignment->Center,ImageSize->700,Dividers->All]

Hypotraceable

hypotraceable=Select[thomassen,GraphData[#,"Hypotraceable"]&]

GraphicsRow[Show[StyleGraphs[GraphData[#]],PlotLabel->TextCell[Style[GraphData[#,"Name"],Directive[14,Italic,Black,FontFamily->"Times"]],PageWidth->170,TextAlignment->Center]]&/@hypotraceable,Alignment->Top,ImageSize->700,Dividers->All]

Embeddings

<<MathWorld`Graphs`

"ThomassenGraph20"

Names

GraphData["ThomassenGraph20","StandardName"]

GraphData["ThomassenGraph20","StandardNames"]

Primary

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

Thomassen construction

v={{41,29},{270,24},{513,33},{744,28},{743,279},{383,347},{42,281},{94,96},{218,252},{228,87},{99,215},{316,186},{459,189},{332,94},{382,261},{453,91},{551,99},{544,261},{677,97},{676,218}};

v0=(#-Mean[v])&/@v;
vv=v0/Max[Abs[Flatten[v0]]]//N

edges=Join[
Join@@(Partition[#,2,1]&/@{Range[8,16],{1,8,12,16},{7,11},{9,6,18,19,4},{5,20,17},{19,13,20},{17,18},{10,2,14},{16,3,17},{6,15}}),
Join@@(Partition[#,2,1,1]&/@{Range[7]})]

g=Graph[Range@Length@vv,UndirectedEdge@@@edges,VertexCoordinates->vv,VertexLabels->Automatic]

RecognizeGraph@g

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThomassenGraph20","EdgeList"]]

Default embedding

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

GraphData["ThomassenGraph20","Graph","Labeled"]

v=GraphEmbedding[%];

EuclideanDistance[Mean[v[[{8,10,12,9,11}]]],v[[9]]]

EuclideanDistance@@v[[{2,4}]]//FullSimplify

RegionIntersection[InfiniteLine[v[[{2,8}]]],InfiniteLine[v[[{1,11}]]]]//RootReduce

N[%]

{x,y}={(NumericalApproximation[Root, (RowDefault["-0.951", FEExpressionsNumericalApproximationElider]), Root[5-20 ((#1)^2)+16 ((#1)^4)&,1], ]),(1/4) (-1-3 (Sqrt[5]))};

RegionIntersection[InfiniteLine[{#,v[[16,2]]}&/@{-1,1}],InfiniteLine[v[[{6,10}]]]]//RootReduce

a=(NumericalApproximation[Root, (RowDefault["-4.03", FEExpressionsNumericalApproximationElider]), Root[5-260 ((#1)^2)+16 ((#1)^4)&,1], ]);

v=Join[Union@@RootReduce[Table[CirclePoints[{i(Sqrt[(1/2) (5+(Sqrt[5]))]),0},1,5],{i,-1,1}]],{{-x,y},{0,-y},{x,y},{a,y},{-a,y},{-a,-y},{a,-y}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[17,16,14,18,19,15,20,17,6,10,13,7,18],e[20,4,8,16,11,1,12,14,9,5,19],e[6,2,8],e[2,15,3,7],{4,10},e[13,5],{3,9},{10,12},{11,13},{1,15}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["ThomassenGraph20","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

GraphPlot@

v1={{2,0},{4,0},{0,1},{1,1},{1,2},{3,2},{1,3},{2,3},{3,3},{0,4},{4,4}};
v={#/8,#2/4}&@@@Union[{-#,#2}&@@@v1,v1];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,5,15,19,20,11,2,1,3,4,11,18,17,19],{5,6},{15,16},e[2,9,8,7,10,12,13,14,20],e[4,6,9],e[14,16,18],e[3,8,13,17],{7,15},{5,12},{10,11}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["ThomassenGraph20","Circulant"]

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

Halin

GraphData["ThomassenGraph20","Halin"]

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

Rigid

GraphData["ThomassenGraph20","Rigid"]

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

Flexible

GraphData["ThomassenGraph20","Flexible"]

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

LCF

GraphData["ThomassenGraph20","LCF"]

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

UnitDistance

GraphData["ThomassenGraph20","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThomassenGraph20","VertexList"],GraphData["ThomassenGraph20","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance construction NSolve Method->"Homotopy", WorkingPrecision->Infinity

GraphData["ThomassenGraph20",{"TriangleCount","SquareCount"}]

g0=;

p=CirclePoints[(Sqrt[((5-(Sqrt[5]))/10)]),5];

Graph[Range@Length@p,UnitEdges[p],VertexCoordinates->p,VertexLabels->Automatic]

Clear[a,b,c,d,e,f,g,h,i,x,y];
v={
(*1*) {-x,y},p[[4]],p[[2]],{h,i},{d,e},
(*6*) p[[3]]+{0,1},{-f,g},{-b,c},{-d,e},{-h,i},
(*11*) {j,k},{-1/2,a},{1/2,a},p[[1]],p[[3]],
(*16*) p[[5]],{x,y},{f,g},{-j,k},{b,c}
};

Graph[Range@Length@v,EdgeList[g0],VertexCoordinates->GraphEmbedding[g0],VertexLabels->Thread[Range[20]->(MatrixForm/@v/.(p[[3]]+{0,1})->Subscript["p",3]+MatrixForm[{1,0}]/.Thread[p->Table[Subscript["p",i],{i,5}]])]]

eqn=DeleteCases[UnitEdgeEquations[v,EdgeList[g0]]//FullSimplify//Union,True]

eqn//Column//TraditionalForm

var=Variables[Subtract@@@eqn]

Length/@{eqn,var}

$Version

(nsoln=NSolve[eqn,var,Reals,Method->"Homotopy",WorkingPrecision->Infinity])//Timing

Length[nsoln]

polys=Subtract@@@eqn;

Max[N[Abs[polys/.nsoln],1000]]//Quiet

sols=var/.nsoln;

Length[rts=Union[sols,SameTest->(Norm[#1-#2]<1/10&)]]

Precision[rts]

Select[MapIndexed[#2[[1]]->Graph[Range[Length@v],EdgeList[g0],VertexCoordinates->(v/.#)]&,Union@nsoln],UnitDistanceGraphEmbeddingQ[#[[2]]]&]

rts

UnitDistance construction NSolve + FindSystemRoot

GraphData["ThomassenGraph20",{"TriangleCount","SquareCount"}]

g0=;

p=CirclePoints[(Sqrt[((5-(Sqrt[5]))/10)]),5];

Graph[Range@Length@p,UnitEdges[p],VertexCoordinates->p,VertexLabels->Automatic]

Clear[a,b,c,d,e,f,g,h,i,x,y];
v={
(*1*) {-x,y},p[[4]],p[[2]],{h,i},{d,e},
(*6*) p[[3]]+{0,1},{-f,g},{-b,c},{-d,e},{-h,i},
(*11*) {j,k},{-1/2,a},{1/2,a},p[[1]],p[[3]],
(*16*) p[[5]],{x,y},{f,g},{-j,k},{b,c}
};

Graph[Range@Length@v,EdgeList[g0],VertexCoordinates->GraphEmbedding[g0],VertexLabels->Thread[Range[20]->(MatrixForm/@v/.(p[[3]]+{0,1})->Subscript["p",3]+MatrixForm[{1,0}]/.Thread[p->Table[Subscript["p",i],{i,5}]])]]

eqn=DeleteCases[UnitEdgeEquations[v,EdgeList[g0]]//FullSimplify//Union,True]

eqn//Column//TraditionalForm

var=Variables[Subtract@@@eqn]

Length/@{eqn,var}

Numeric:

(nsoln=NSolve[eqn,var,Reals])//Timing

Select[MapIndexed[#2[[1]]->Graph[Range[Length@v],EdgeList[g0],VertexCoordinates->(v/.#)]&,nsoln],UnitDistanceGraphEmbeddingQ[#[[2]]]&]

Numerical with WorkingPrecision:

(nsoln=NSolve[eqn,var,Reals,WorkingPrecision->50])//Timing

Length[nsoln]

polys=Subtract@@@eqn;

Max[Abs[polys/.nsoln]]

sols=var/.nsoln;

Length[usols=Union[sols,SameTest->(Norm[#1-#2]<1/10&)]]

This  proves (using interval arithmetic) that the numeric solutions approximate actual solutions, hence there are at least 54 real solutions:

(rts=Reduce`FindSystemRoot[polys,var,#,True,45]&/@usols)//Timing

Length[rts]

Element[var/.rts,Reals]

Precision[rts]

Position[DistanceMatrix[N[var/.rts,100]],_?(#<1/10&)]

Union[Subtract@@@%]

Max[Abs[N[Subtract@@@eqn/.rts,10^3]]]//Timing

degen=Select[MapIndexed[#2[[1]]->Graph[Range[Length@v],EdgeList[g0],VertexCoordinates->(v/.#)]&,rts],DegenerateGraphEmbeddingQ[#[[2]],"Type"->"VertexVertex"]&]

Length[degen]

ud=Select[MapIndexed[#2[[1]]->Graph[Range[Length@v],EdgeList[g0],VertexCoordinates->(v/.#)]&,rts],UnitDistanceGraphEmbeddingQ[#[[2]]]&]

Length[ud]

ByteCount/@ud

exactgs={,,,,};

gs=Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]]&/@exactgs

Exactify:

exactgs={,,,,};

v=GraphEmbedding[exactgs[[1]]]

N[v]

ToAlgebraicRoot[v[[1,1]],"MaxDegree"->512]//Timing

RootReduce[v[[1,1]]]//Timing

Homotopy:

NSolve[Subtract@@@eqn,var,Reals,Method->"Homotopy",WorkingPrecision->50]

Symbolic:

(soln=Solve[eqn,var,Reals])//Timing

...ran over a couple days...

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

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

Matchstick

GraphData["ThomassenGraph20","Matchstick"]

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

3D default

Graph3D[GraphData["ThomassenGraph20","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["ThomassenGraph20","Polyhedral"]

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

"ThomassenGraph24"

Names

GraphData["ThomassenGraph24","StandardName"]

GraphData["ThomassenGraph24","StandardNames"]

Thomassen construction

Thomassen, C.  ``Planar Cubic Hypohamiltonian and Hypotraceable Graphs.''  {\it J.\ Comb.\ Th.\ B} {\bf 30}, 36--44, 1981.

Fig. 2:

v={{0.25`,2.96062`},{2.7600000000000002`,4.72062`},{5.45`,2.98062`},{5.28`,2.21062`},{5.43`,1.51062`},{3.19`,0.080625`},{2.45`,0.080625`},{0.25`,1.4506200000000002`},{0.4`,2.21062`},{1.84`,2.96062`},{2.72`,3.96062`},{3.84`,2.98062`},{4.0200000000000005`,2.23062`},{3.89`,1.48062`},{1.82`,1.51062`},{1.67`,2.21062`},{4.38`,2.7606200000000003`},{4.36`,1.6906200000000002`},{4.91`,2.7606200000000003`},{4.88`,1.6606200000000002`},{0.76`,2.77062`},{0.78`,1.7006200000000002`},{1.31`,2.73062`},{1.32`,1.73062`}};

edges=Join@@(Partition[#,2,1]&/@{{1,2,3,4,5,6,7,8,9,1},{10,11,12,13,14,7},{6,15,16,10},{14,18,20,5},{12,17,19,3},{8,22,24,15},{1,21,23,10},{4,13},{9,16},{21,22},{23,24},{17,18},{19,20},{11,2}})

g=Graph[Range@Length@v,UndirectedEdge@@@edges,VertexCoordinates->v]

r=RecognizeGraph@g

Primary

GraphData["ThomassenGraph24"]//StyleGraphs

All

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

LCF

GraphData["ThomassenGraph24","LCFSignature"]

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

UnitDistance

UnitDistanceGraphQ[GraphData["ThomassenGraph24"],Debug->True]

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

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

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

UnitDistance FindSubgraphIsomorphism

l=FindSubgraphIsomorphism[GraphData["ThomassenGraph24"],"Results"->All]//Timing

l={"ThomassenGraph24",{6710.597576`,{{"DeGreyGraph1581",{4.813789`,{}}},{"HeuleGraph510",{13.345844`,{}}},{"HeuleGraph517",{3.502617`,{}}},{"HeuleGraph529",{4.236617`,{}}},{"HeuleGraph553",{2.775776`,{}}},{"HeuleGraph610",{4.039782`,{}}},{"HeuleGraph633",{3.661183`,{}}},{"HeuleGraph803",{6.478306`,{}}},{"HeuleGraph826",{7.268588`,{}}},{"HeuleGraph874",{12.717064`,{}}},{"PartsGraph525",{5.242645`,{}}},{"PartsGraph529",{2.59267`,{}}},{"PartsGraph553",{4.471992`,{}}},{{"TriangularHoneycombObtuseKnight",10},{34.442828`,{}}},{{"TriangularHoneycombObtuseKnight",11},{81.429289`,{}}},{{"TriangularHoneycombObtuseKnight",12},{9.207691`,{}}},{{"TriangularHoneycombObtuseKnight",13},{11.868207`,{}}},{{"TriangularHoneycombObtuseKnight",14},{13.497641`,{}}},{{"TriangularHoneycombObtuseKnight",15},{14.519981`,{}}},{{"TriangularHoneycombObtuseKnight",16},{15.037831`,{}}},{{"TriangularHoneycombObtuseKnight",17},{15.184644`,{}}},{{"TriangularHoneycombObtuseKnight",18},{15.313106`,{}}},{{"TriangularHoneycombObtuseKnight",19},{15.337048`,{}}},{{"TriangularHoneycombObtuseKnight",20},{15.40612`,{}}},{{"UnitDistance",{118,1}},{48.842283`,{}}},{{"UnitDistance",{391,1}},{30.372297`,{}}}}}};

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing

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

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

3D

Graph3D[GraphData["ThomassenGraph24","Edges"]]

Nice embedding

v0={#-1,#2}&@@@{{2,2},{3,2},{4,2},{5,2},{2,3},{5,3},{2,4},{3,4},{4,4},{5,4}};
v=Join[{-#,#2}&@@@v0,v0,{{-1/2,1/2},{1/2,1/2},{0,5},{0,6}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[21,22,14,16,20,24,10,6,4,21],e[21,11,15,17,23,7,5,1,22],{23,24},e[11,12,13,14],e[17,18,19,20],e[4,3,2,1],e[10,9,8,7],{15,16},{5,6},{12,18},{13,19},{3,9},{2,8}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

Default embedding

g=GraphPlot@GraphData["ThomassenGraph24","Edges"]

v={{0,0},{2,0},{3,0},{5,0},{6,0},{8,0},{3,1},{5,1},{1,2},{2,2},{3,2},{5,2},{6,2},{7,2},{0,3},{2,3},{4,3},{6,3},{8,3},{0,4},{3,4},{4,4},{5,4},{8,4}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,4,5,6,19,24,23,22,21,20,15,1,9,20],e[15,16,17,18,19],e[6,14,24],e[9,7,4],e[3,8,14],{10,11},{12,13},e[2,10,16],e[8,12,23],e[5,13,18],e[7,11,21],{17,22}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["ThomassenGraph24"],"CrossingNumber"->4],Pi/2+.2]

v={{0,0},{7,0},{2,1},{3,1},{4,1},{2,2},{3,2},{5,2},{6,2},{7,2},{0,3},{1,3},{2,3},{4,3},{0,4},{2,4},{6,4},{1,5},{2,5},{6,5},{1,6},{6,6},{0,7},{7,7}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,5,14,13,6,3,1,11,15,23,24,17,9,10,2,5],e[2,4,3],e[24,22,20,10],e[23,21,22],e[21,18,19,20],e[15,16,17],{19,16},e[11,12,13],e[6,7,8,9],{12,18},{4,7},{8,14}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

"ThomassenGraph32"

GraphData["ThomassenGraph32","StandardName"]

Primary

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

Thomassen construction

v={{43,35},{68,115},{113,212},{144,295},{107,381},{66,464},{25,553},{111,516},{211,476},{294,445},{368,475},{467,518},{562,561},{523,458},{485,376},{452,307},{492,216},{536,111},{572,35},{476,67},{391,107},{306,144},{215,105},{121,63},{263,183},{199,245},{186,335},{249,397},{338,401},{406,345},{409,254},{349,189}};

v0=(#-Mean[v])&/@v;
vv=v0/Max[Abs[Flatten[v0]]]//N

edges=Join[Join@@(Partition[#,2,1]&/@{{2,25},{24,26},{3,23},{10,22},{5,9},{11,15},{21,17},{8,27},{6,28},{29,14},{30,12},{32,18},{31,20}}),
Join@@(Partition[#,2,1,1]&/@{Range[24],{4,27,28,10,29,30,16,31,32,22,25,26},{1,7,13,19}})]

g=Graph[Range@Length@vv,UndirectedEdge@@@edges,VertexCoordinates->vv]

RecognizeGraph@g

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThomassenGraph32","EdgeList"]]

Default embedding

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

Partition[{3,6,2,5,1,8,4,7},2,1,1]

v=Join[CirclePoints[4],c=CirclePoints[{1/3,0},4]];v=Union[v,Sequence@@Subdivide[Sequence@@v[[#]],3]&/@Partition[{3,6,2,5,1,8,4,7},2,1,1]];
v=Union[v,Sequence@@Subdivide[Sequence@@v[[#]],3]&/@Partition[{1,3,4,2},2,1,1]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[13,19,20,14,13,21,15,6,17,23,19,31,27,12,28,32,20,24,18,7,16,22,14,30,26,1,25,29,13],e[6,8,10,12,11,9,7,5,3,1,2,4,6,7],{21,2},{4,29},{25,15},{17,27},{18,28},{26,16},{5,30},{22,3},{9,32},{11,24},{8,31},{23,10}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["ThomassenGraph32","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

GraphPlot@RotateGraph[,{1,7}]

v1={#/14,#2/8}&@@@{{7,0},{3,1},{0,2},{1,2},{2,2},{2,3},{2,4},{1,5},{2,5},{3,6},{3,7},{4,7},{5,7},{6,7},{7,7},{0,8},{7,8}};
v=Union[{-#,#2}&@@@v1,v1];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[30,24,7,1,30,31,32,17,3,2,1,6],e[5,17,28],e[13,7,10,14,16,18,20,24,23],e[2,4,5,6,9,8,25,26,27,28,29,31],{8,11},{25,21},{3,9},{26,32},e[8,15,14],e[18,19],e[10,11,12,13],e[20,21,22,23],e[12,16,22],{13,15},{19,23},{4,8},e[19,25,29],{27,30}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["ThomassenGraph32","Circulant"]

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

Halin

GraphData["ThomassenGraph32","Halin"]

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

Rigid

GraphData["ThomassenGraph32","Rigid"]

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

Flexible

GraphData["ThomassenGraph32","Flexible"]

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

LCF

GraphData["ThomassenGraph32","LCF"]

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

UnitDistance

GraphData["ThomassenGraph32","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThomassenGraph32","VertexList"],GraphData["ThomassenGraph32","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

g=CenterGraph@Annotate[UnitDistanceEmbeddingRefine[,WorkingPrecision->5000,PrecisionGoal->2500],Axes->True]

v=GraphEmbedding[g];

Map[ToAlgebraicRoot[#,"MaxDegree"->32]&,N[v,2000],{2}]

UnitDistance construction

GraphData["ThomassenGraph32",{"TriangleCount","SquareCount"}]

squares=FindCycle[GraphData["ThomassenGraph32"],{4},All]

HighlightGraph[g=GraphData["ThomassenGraph32","Graph","UnitDistance"][[1]],squares]

v={
(* 0 *) {-1/2,-1/2},{-ee,-f},{-k,-l},{x,0},{-k,l},
(* 6 *) {-ee,f},{-1/2,1/2},{-c,d},{-a,b},{0,1/2},
(* 11 *) {a,b},{c,d},{1/2,1/2},{ee,f},{k,l},
(* 16 *) {-x,0},{k,-l},{ee,-f},{1/2,-1/2},{c,-d},
(* 21 *) {a,-b},{0,-1/2},{-a,-b},{-c,-d},{-g,-h},
(* 26 *) {-i,-j},{-i,j},{-g,h},{g,h},{i,j},
(* 31 *) {1/2,-1/2},{g,-h}
};

eqn=FullSimplify[UnitEdgeEquations[v,edges=GraphData["ThomassenGraph32","Edges"]]]//Union

var=Variables[Subtract@@@eqn]

Length/@{eqn,var}

(soln=Solve[eqn,var,Reals]//FullSimplify)//Timing

Length[soln]

gs=Graph[Range[32],edges,VertexCoordinates->(v/.#)]&/@soln//UniqueEmbeddings

UnitDistanceGraphEmbeddingQ/@gs

Union[N[EdgeLengths[#],20],SameTest->(Abs[#-#2]<1*^-6&)]&/@gs

DegenerateGraphEmbeddingQ/@gs

DegenerateGraphEmbeddingTypes/@gs

Select[%,FreeQ[#,"DegenerateVertexVertex"]&]

LabelGraph@

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["ThomassenGraph32","Matchstick"]

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

3D default

Graph3D[GraphData["ThomassenGraph32","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["ThomassenGraph32","Polyhedral"]

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

"ThomassenGraph34"

Names

GraphData["ThomassenGraph34","StandardName"]

GraphData["ThomassenGraph34","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThomassenGraph34","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Circular construction

GraphData["ThomassenGraph34","Hamiltonian"]

GraphData["ThomassenGraph34","HamiltonianCycleCount"]

Planar

GraphData["ThomassenGraph34","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

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

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

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

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

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

GraphPlot@RotateGraph[,-.4]

v={#/12,#2/7}&@@@Join[{{0,0},{6,0},{12,0}},{#,1}&/@{1,2,3,4,5,7,8,9,10,11},{{0,2},{12,2},{4,3},{8,3},{0,4},{1,4},{2,4},{10,4},{11,4},{12,4},{0,5},{2,5},{10,5},{12,5},{1,6},{2,6},{10,6},{11,6},{0,7},{6,7},{12,7}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[4,5,6,7,8,2,9,10,11,12,13,3,15,23,27,34,33,32,24,18,14,1,4,16],e[20,25,29,28,32],e[34,31,30,17,13],e[18,19,20,33,21,22,23],{24,25},{26,27},{19,28},{22,31},e[21,26,30],e[14,6],{15,11},{7,16},{10,17},{1,8},{9,3},e[5,2,12],{16,29}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

v={#/12,(#2-If[#2>2,1,0])/6}&@@@Join[{{0,0},{6,0},{12,0}},{#,1}&/@{1,2,3,4,5,7,8,9,10,11},{{0,2},{12,2},{4,3},{8,3},{0,4},{1,4},{2,4},{10,4},{11,4},{12,4},{0,5},{2,5},{10,5},{12,5},{1,6},{2,6},{10,6},{11,6},{0,7},{6,7},{12,7}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[4,5,6,7,8,2,9,10,11,12,13,3,15,23,27,34,33,32,24,18,14,1,4,16],e[20,25,29,28,32],e[34,31,30,17,13],e[18,19,20,33,21,22,23],{24,25},{26,27},{19,28},{22,31},e[21,26,30],e[14,6],{15,11},{7,16},{10,17},{1,8},{9,3},e[5,2,12],{16,29}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["ThomassenGraph34","Circulant"]

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

Halin

GraphData["ThomassenGraph34","Halin"]

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

Rigid

GraphData["ThomassenGraph34","Rigid"]

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

Flexible

GraphData["ThomassenGraph34","Flexible"]

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

LCF

GraphData["ThomassenGraph34","LCF"]

GraphData["ThomassenGraph34","HamiltonianCycleCount"]

GraphData["ThomassenGraph34","LCFSignature"]

GraphData["ThomassenGraph34","LCFNotations"]

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

UnitDistance

GraphData["ThomassenGraph34","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThomassenGraph34","VertexList"],GraphData["ThomassenGraph34","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["ThomassenGraph34","Matchstick"]

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

3D default

Graph3D[GraphData["ThomassenGraph34","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["ThomassenGraph34","Polyhedral"]

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

"ThomassenGraph41"

Names

GraphData["ThomassenGraph41","StandardName"]

GraphData["ThomassenGraph41","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThomassenGraph41","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["ThomassenGraph41","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

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

Minimal crossing construction Davidson-Hare

g0=;

IGLayoutDavidsonHarel[
IGVertexMap[#&,VertexCoordinates->(Rescale@GraphEmbedding[#,"PlanarEmbedding"]&),g0],
"Continue"->True,"EdgeCrossingWeight"->1000
]

GraphPlot@RotateGraph[%,Pi/2]

RecognizeGraph@g

RectilinearCrossingCount@g

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["ThomassenGraph41","Circulant"]

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

Halin

GraphData["ThomassenGraph41","Halin"]

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

Rigid

GraphData["ThomassenGraph41","Rigid"]

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

Flexible

GraphData["ThomassenGraph41","Flexible"]

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

LCF

GraphData["ThomassenGraph41","LCF"]

GraphData["ThomassenGraph41","HamiltonianCycleCount"]

GraphData["ThomassenGraph41","LCFSignature"]

GraphData["ThomassenGraph41","LCFNotations"]

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

UnitDistance

GraphData["ThomassenGraph41","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThomassenGraph41","VertexList"],GraphData["ThomassenGraph41","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["ThomassenGraph41","Matchstick"]

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

3D default

Graph3D[GraphData["ThomassenGraph41","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["ThomassenGraph41","Polyhedral"]

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

"ThomassenGraph60"

GraphData["ThomassenGraph60","StandardName"]

Thomassen construction

v={{204,15.25},{15,285.25},{60,284.25},{118,285.25},{194,285.25},{229,288.25},{274,285.25},{340,199.25},{320,172.25},{302,141.25},{262,97.25},{237,63.25},{113,487.25},{556,482.25},{527,441.25},{486,391.25},{447,345.25},{424,313.25},{405,288.25},{247,318.25},{228,347.25},{185,390.25},{169,421.25},{487,18.25},{672,286.25},{601,291.25},{554,286.25},{489,286.25},{445,286.25},{360,173.25},{383,147.25},{423,97.25},{449,64.25},{498,72.25},{509,114.25},{472,172.25},{435,161.25},{517,183.25},{569,218.25},{618,249.25},{501,249.25},{508,229.25},{494,467.25},{409,450.25},{420,362.25},{365,405.25},{335,430.25},{289,393.25},{259,368.25},{252,453.25},{177,468.25},{180,248.25},{177,214.25},{172,178.25},{107,224.25},{80,244.25},{219,164.25},{253,158.25},{185,119.25},{190,81.25}};

v0=(#-Mean[v])&/@v;
vv=v0/Max[Abs[Flatten[v0]]]//N

edges=Join[
Join@@(Partition[#,2,1]&/@{{2,3,4,5,6,7,19,29,28,27,26,25},{13,23,22,21,20,7,8,30,31,32,33,24},{14,15,16,17,18,19,8,9,10,11,12,1},{13,51,50,47,44,43,14},{24,34,35,38,39,40,25},{1,60,59,54,55,56,2},{6,9},{5,10},{20,18},{21,17},{30,29},{28,31},{21,49,48,47,46,45,17},{31,37,36,38,42,41,28},{10,58,57,54,53,52,5},{23,48},{22,50},{44,16},{3,53},{33,36},{56,52},{55,4},{58,60},{59,11},{12,57},{37,34},{46,15},{45,43},{32,35},{42,26},{27,39},{41,40},{51,49}}),
Join@@(Partition[#,2,1,1]&/@{{1,2,13,14,25,24}})]

g=Graph[Range@Length@v,UndirectedEdge@@@edges,VertexCoordinates->v]

RecognizeGraph@g

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThomassenGraph60","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["ThomassenGraph60","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

GraphPlot@

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["ThomassenGraph60","Circulant"]

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

Halin

GraphData["ThomassenGraph60","Halin"]

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

Rigid

GraphData["ThomassenGraph60","Rigid"]

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

Flexible

GraphData["ThomassenGraph60","Flexible"]

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

LCF

GraphData["ThomassenGraph60","LCF"]

GraphData["ThomassenGraph60","HamiltonianCycleCount"]

GraphData["ThomassenGraph60","LCFSignature"]

GraphData["ThomassenGraph60","LCFNotations"]

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

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

UnitDistance

GraphData["ThomassenGraph60","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThomassenGraph60","VertexList"],GraphData["ThomassenGraph60","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["ThomassenGraph60","Matchstick"]

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

3D default

Graph3D[GraphData["ThomassenGraph60","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["ThomassenGraph60","Polyhedral"]

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

"ThomassenGraph94"

GraphData["ThomassenGraph94","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThomassenGraph94","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["ThomassenGraph94","Planar"]

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

Tutte embeddings

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

Tally[ReverseSort[Length/@faces]]

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

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

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

UnitDistance

GraphData["ThomassenGraph94","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThomassenGraph94","VertexList"],GraphData["ThomassenGraph94","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

Select[UnitDistanceEmbeddingRefine/@{,,,,,,,,,,,,,,,},UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["ThomassenGraph94"]]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["ThomassenGraph94","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

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

3D Canonical

GraphData["ThomassenGraph94","Graph",{"3D","Canonical"}]

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

3D Polyhedron construction

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

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

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//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]

"ThomassenGraph105"

GraphData["ThomassenGraph105","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThomassenGraph105","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["ThomassenGraph105","Planar"]

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

Tutte embeddings

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

Tally[ReverseSort[Length/@faces]]

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

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

RecognizeGraph/@gs

Tutte embedding construction 10 (around square)

GraphData["ThomassenGraph105","Graph",2]

Tutte embedding construction 5

GraphPlot[RotateGraph[]]

g0=;

Show[g0,Axes->True]

v=GraphEmbedding[g0];

Plot[(Sqrt[1-(x^2)]),{x,0,1}]

v2=#((Sqrt[1-Norm[#]^2 .75]))&/@v//Chop[#,1*^-4]&

g=Annotate[g0,VertexCoordinates->v2]

RecognizeGraph[g]

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

RecognizeGraph[g]

Halin

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

LCF

GraphData["ThomassenGraph105","LCFSignature"]

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

UnitDistance

GraphData["ThomassenGraph105","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThomassenGraph105","VertexList"],GraphData["ThomassenGraph105","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

3D default

Graph3D[GraphData["ThomassenGraph105","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

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

3D Canonical

GraphData["ThomassenGraph105","Graph",{"3D","Canonical"}]

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

3D Polyhedron construction

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

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

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

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

(can=FindCanonicalPolyhedron[can,WorkingPrecision->1000,MaxIterations->100000,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]