Quartic Vertex-Transitive Graph

Author

Eric W. Weisstein
July 30, 2024

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/QuarticVertex-TransitiveGraph.nb.

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

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

Table

SortBy[GraphData[{"Quartic","VertexTransitive"}],GraphData[#,"V"]&]

DeleteCases[Sort[("Qt"/.GraphData[#,"NotationRules"])&/@GraphData[{"Connected","Quartic","VertexTransitive"}]],"Qt"|None]

Complement[Range[72],Drop[%,-2]]

TableForm[Reverse/@Sort[{"Qt"/.GraphData[#,"NotationRules"],GraphData[#,"Name"],GraphData[#,"V"]}&/@GraphData[{"Connected","Quartic","VertexTransitive"},;;19]],TableDepth->2]

Figure

qt=Flatten[Insert["Qt"<>ToString[#]&/@Join[Range[25],Range[28,72]],{{"Circulant",{13,{1,3}}},{"Circulant",{13,{1,5}}}},26],1]

GraphicsGrid[Partition[Show[GraphData[#],PlotLabel->TextCell["Qt"<>ToString["Qt"/.GraphData[#,"NotationRules"]]<>"\n"<>GraphData[#,"Name"],PageWidth->90,TextAlignment->Center],BaseStyle->{FontSlant->"Italic"}]&/@Take[qt,25],5,5,{1,1},{}],ImageSize->500]

Construction

<<MathWorld`Graphs`

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

{,,}

{"QuarticTransitive", 1} == "PentatopeGraph"

GraphData[{"QuarticTransitive",1},"StandardName"]

{"QuarticTransitive", 2} == "OctahedralGraph"

GraphData[{"QuarticTransitive",2},"StandardName"]

{"QuarticTransitive", 3} == {"Circulant", {7, {1, 2}}}

GraphData[{"QuarticTransitive",3},"StandardName"]

{"QuarticTransitive", 4} == {"Antiprism", 4}

GraphData[{"QuarticTransitive",4},"StandardName"]

{"QuarticTransitive", 5} == {"Rook", {2, 4}}

GraphData[{"QuarticTransitive",5},"StandardName"]

{"QuarticTransitive", 6} == {"CompleteBipartite", {4, 4}}

GraphData[{"QuarticTransitive",6},"StandardName"]

{"QuarticTransitive", 7} == {"Circulant", {9, {1, 3}}}

GraphData[{"QuarticTransitive",7},"StandardName"]

{"QuarticTransitive", 8} == {"Circulant", {9, {1, 2}}}

GraphData[{"QuarticTransitive",8},"StandardName"]

{"QuarticTransitive", 9} == {"GeneralizedQuadrangle", {2, 1}}

GraphData[{"QuarticTransitive",9},"StandardName"]

{"QuarticTransitive", 10} == {"Antiprism", 5}

GraphData[{"QuarticTransitive",10},"StandardName"]

{"QuarticTransitive", 11} == {"Crown", 5}

GraphData[{"QuarticTransitive",11},"StandardName"]

{"QuarticTransitive", 12} == {"Circulant", {10, {1, 4}}}

GraphData[{"QuarticTransitive",12},"StandardName"]

{"QuarticTransitive", 13} == {"Circulant", {11, {1, 2}}}

GraphData[{"QuarticTransitive",13},"StandardName"]

{"QuarticTransitive", 14} == {"Andrasfai", 4}

GraphData[{"QuarticTransitive",14},"StandardName"]

{"QuarticTransitive", 15} == {"Antiprism", 6}

GraphData[{"QuarticTransitive",15},"StandardName"]

{"QuarticTransitive", 16} == {"Circulant", {12, {1, 4}}}

GraphData[{"QuarticTransitive",16},"StandardName"]

{"QuarticTransitive", 17}

Names

GraphData[{"QuarticTransitive",17},"StandardName"]

GraphData[{"QuarticTransitive",17},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",17}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,11},{2,4},{2,6},{2,12},{3,4},{3,5},{3,10},{4,6},{4,9},{5,7},{5,8},{6,7},{6,8},{7,9},{7,11},{8,10},{8,12},{9,10},{9,11},{10,12},{11,12}},VertexCoordinates->(10^(-4)){{6349,-19551},{6349,-337},{11973,-11593},{11973,-8296},{14302,-13924},{14302,-5965},{17596,-13924},{17596,-5965},{19926,-11593},{19926,-8296},{25550,-19551},{25550,-337}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",17},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",17},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",17},"Edges"]

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

RecognizeGraph[g]

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

RecognizeGraph@g

Degenerate

GraphData[{"QuarticTransitive",17},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"QuarticTransitive",17},"Graph","Degenerate"]

Bilateral

GraphData[{"QuarticTransitive",17},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",17},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",17},"Planar"]

GraphData[{"QuarticTransitive",17},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",17},{"RCN","CN"}]

GraphData[{"QuarticTransitive",17},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",17}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",17}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",17}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphData[{"QuarticTransitive",17},"V"]

GraphPlot@MinimalCrossingGraph[GraphData[{"QuarticTransitive",17}],"CrossingNumber"->5]

GraphPlot@HighlightGraph[RotateGraph[GraphicsToGraph@,Pi/2],Range[12+1,12+5]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

MinimalLocalCrossing

GraphData[{"QuarticTransitive",17},"LocalCrossingNumber"]

GraphData[{"QuarticTransitive",17},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalLocalCrossing construction

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

(cn=CrossingNumber[GraphData[{"QuarticTransitive",17}],TimeConstraint->1])//AbsoluteTiming

Select[Table[MinimalCrossingGraph[GraphData[{"QuarticTransitive",17}],"CrossingNumber"->cn,RandomSeed->i],{i,5000}],!AdjacentCrossingsQ[#,cn]&]//Union//Timing

Select[Table[MinimalCrossingGraph[GraphData[{"QuarticTransitive",17}],"CrossingNumber"->(cn=6),RandomSeed->i],{i,5000}],!AdjacentCrossingsQ[#,cn]&]//Union//Timing

GraphPlot@

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

RecognizeGraph@g

RectilinearCrossingCount@g

LocalCrossingCount@g

GraphPlot@

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

RecognizeGraph@g

RectilinearCrossingCount@g

LocalCrossingCount@g

gs=UnlabelGraph/@{,}

Circulant

GraphData[{"QuarticTransitive",17},"Circulant"]

GraphData[{"QuarticTransitive",17},"Graph","Circulant"]//StyleGraphs

Line graph

GraphData[{"QuarticTransitive",17},"Line"]

LineGraphQ[GraphData[{"QuarticTransitive",17}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"QuarticTransitive",17}&]

RootGraph[GraphData[{"QuarticTransitive",17}]]

Halin

GraphData[{"QuarticTransitive",17},"Halin"]

GraphData[{"QuarticTransitive",17},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"QuarticTransitive",17},"Rigid"]

GraphData[{"QuarticTransitive",17},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"QuarticTransitive",17},"Flexible"]

GraphData[{"QuarticTransitive",17},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",17},"LCF"]

GraphData[{"QuarticTransitive",17},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",17},"LCFSignature"]

GraphData[{"QuarticTransitive",17},"LCFNotations"]

GraphData[{"QuarticTransitive",17},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",17}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",17}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",17},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",17}],Debug->True]//Timing

GraphData[{"QuarticTransitive",17},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",17},"VertexList"],GraphData[{"QuarticTransitive",17},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

RecognizeGraph@

g=RotateGraph[,{8,5}]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",17}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

{0.126953`,}

g=RotateGraph[LabelGraph@,{5,3}]

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",17}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"QuarticTransitive",17},"Matchstick"]

GraphData[{"QuarticTransitive",17},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",17},"Edges"]]

3D All

GraphData[{"QuarticTransitive",17},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",17},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",17},"Polyhedral"]

{"QuarticTransitive", 18} == {"Circulant", {12, {1, 3}}}

GraphData[{"QuarticTransitive",18},"StandardName"]

{"QuarticTransitive", 19}

Names

GraphData[{"QuarticTransitive",19},"StandardName"]

GraphData[{"QuarticTransitive",19},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",19}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,3},{1,4},{1,5},{2,3},{2,5},{2,9},{3,5},{3,6},{4,6},{4,8},{4,11},{5,7},{6,8},{6,11},{7,9},{7,10},{7,12},{8,10},{8,11},{9,10},{9,12},{10,12},{11,12}},VertexCoordinates->(10^(-4)){{7316,-10485},{11620,-17945},{11620,-10485},{11620,-3024},{13772,-14215},{13772,-6754},{18077,-14215},{18077,-6754},{20229,-17945},{20229,-10485},{20229,-3024},{24533,-10485}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",19},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",19},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",19},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",19},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",19},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",19},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",19},"Planar"]

GraphData[{"QuarticTransitive",19},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",19},{"RCN","CN"}]

GraphData[{"QuarticTransitive",19},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",19}],TimeConstraint->10])//AbsoluteTiming

CrossingNumber[GraphData[{"QuarticTransitive",19}],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData[{"QuarticTransitive",19}],"CrossingNumber"->cn]]

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",19},"Circulant"]

GraphData[{"QuarticTransitive",19},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",19},"Halin"]

GraphData[{"QuarticTransitive",19},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",19},"LCF"]

GraphData[{"QuarticTransitive",19},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",19},"LCFSignature"]

GraphData[{"QuarticTransitive",19},"LCFNotations"]

GraphData[{"QuarticTransitive",19},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",19}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",19}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",19},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",19}],Debug->True]//Timing

GraphData[{"QuarticTransitive",19},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"QuarticTransitive",19},"Matchstick"]

GraphData[{"QuarticTransitive",19},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",19},"Edges"]]

g=EdgeAdd[GraphData[{"Prism",6},"Graph",{"Labeled","3D"}],UndirectedEdge@@@{{1,8},{2,7},{4,9},{3,10},{6,11},{5,12}}]

RecognizeGraph@g

3D All

GraphData[{"QuarticTransitive",19},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",19},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",19},"Polyhedral"]

GraphData[{"QuarticTransitive",19},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 20} == "CuboctahedralGraph"

GraphData[{"QuarticTransitive",20},"StandardName"]

{"QuarticTransitive", 21} == {"Circulant", {12, {3, 4}}}

GraphData[{"QuarticTransitive",21},"StandardName"]

{"QuarticTransitive", 22} == {"Circulant", {12, {2, 3}}}

GraphData[{"QuarticTransitive",22},"StandardName"]

{"QuarticTransitive", 23}

Names

GraphData[{"QuarticTransitive",23},"StandardName"]

GraphData[{"QuarticTransitive",23},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",23}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[12],UndirectedEdge@@@{{1,2},{1,4},{1,5},{1,11},{2,3},{2,6},{2,12},{3,4},{3,5},{3,9},{4,6},{4,10},{5,6},{5,7},{6,8},{7,8},{7,9},{7,11},{8,10},{8,12},{9,10},{9,12},{10,11},{11,12}},VertexCoordinates->(10^(-4)){{6349,-19551},{6349,-337},{11973,-11593},{11973,-8296},{14302,-13924},{14302,-5965},{17596,-13924},{17596,-5965},{19926,-11593},{19926,-8296},{25550,-19551},{25550,-337}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",23},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",23},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",23},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",23},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",23},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",23},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",23},"Planar"]

GraphData[{"QuarticTransitive",23},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",23},{"RCN","CN"}]

GraphData[{"QuarticTransitive",23},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",23}],TimeConstraint->10])//AbsoluteTiming

CrossingNumber[GraphData[{"QuarticTransitive",23}],TimeConstraint->60]//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",23}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

g=RotateGraph[MinimalCrossingGraph[GraphData[{"QuarticTransitive",23}],"CrossingNumber"->cn]]

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

GraphPlot@RotateGraph[,-Pi/4]

GraphPlot@HighlightGraph[RotateGraph[GraphicsToGraph@,-Pi/2],Range[13,18]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,-Pi/4]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,Pi/4]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

gs=UnlabelGraph/@{,,}

Circulant

GraphData[{"QuarticTransitive",23},"Circulant"]

GraphData[{"QuarticTransitive",23},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",23},"Halin"]

GraphData[{"QuarticTransitive",23},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",23},"LCF"]

GraphData[{"QuarticTransitive",23},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",23},"LCFSignature"]

GraphData[{"QuarticTransitive",23},"LCFNotations"]

GraphData[{"QuarticTransitive",23},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",23}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",23}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",23},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",23}],Debug->True]//Timing

GraphData[{"QuarticTransitive",23},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",23},"VertexList"],GraphData[{"QuarticTransitive",23},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",23}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",23}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"QuarticTransitive",23},"Matchstick"]

GraphData[{"QuarticTransitive",23},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",23},"Edges"]]

3D All

GraphData[{"QuarticTransitive",23},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",23},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",23},"Polyhedral"]

GraphData[{"QuarticTransitive",23},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 24} == {"Circulant", {12, {1, 5}}}

GraphData[{"QuarticTransitive",24},"StandardName"]

{"QuarticTransitive", 25} == {"Circulant", {13, {1, 2}}}

GraphData[{"QuarticTransitive",25},"StandardName"]

{"QuarticTransitive", 26} == {"Circulant", {13, {1, 3}}} == {"QuarticTransitive", 27}

GraphData[{"QuarticTransitive",26},"StandardName"]

{"QuarticTransitive", 27} == {"Circulant", {13, {1, 3}}} == {"QuarticTransitive", 26}

GraphData[{"QuarticTransitive",27},"StandardName"]

{"QuarticTransitive", 28} == {"Antiprism", 7}

GraphData[{"QuarticTransitive",28},"StandardName"]

{"QuarticTransitive", 29} == {"Circulant", {14, {1, 4}}}

GraphData[{"QuarticTransitive",29},"StandardName"]

{"QuarticTransitive", 30} == {"Circulant", {14, {1, 3}}}

GraphData[{"QuarticTransitive",30},"StandardName"]

{"QuarticTransitive", 31}

Names

GraphData[{"QuarticTransitive",31},"StandardName"]

GraphData[{"QuarticTransitive",31},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",31}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,7},{1,14},{2,4},{2,8},{2,13},{3,4},{3,5},{3,12},{4,6},{4,11},{5,7},{5,10},{5,11},{6,8},{6,9},{6,12},{7,8},{7,9},{8,10},{9,11},{9,14},{10,12},{10,13},{11,13},{12,14},{13,14}},VertexCoordinates->(10^(-4)){{8325,-10685},{9137,-14245},{9137,-7124},{11412,-17100},{11412,-4269},{14700,-18684},{14700,-2685},{18349,-18684},{18349,-2685},{21637,-17100},{21637,-4269},{23912,-14245},{23912,-7124},{24724,-10685}}]

RecognizeGraph@g

Construction from distanceregular.org

GraphData[{"QuarticTransitive",31},"StandardName"]

DistanceRegularGraph["http://www.distanceregular.org/graphdata/heawood-dist3.am"]

RecognizeGraph[%]

All

GraphData[{"QuarticTransitive",31},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",31},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",31},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"QuarticTransitive",31},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"QuarticTransitive",31},"Graph","Degenerate"]

Bilateral

GraphData[{"QuarticTransitive",31},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",31},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",31},"Planar"]

GraphData[{"QuarticTransitive",31},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",31},{"RCN","CN"}]

GraphData[{"QuarticTransitive",31},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",31}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",31}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",31}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

GraphPlot@RotateGraph[,3Pi/4]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",31},"Circulant"]

GraphData[{"QuarticTransitive",31},"Graph","Circulant"]//StyleGraphs

Line graph

GraphData[{"QuarticTransitive",31},"Line"]

LineGraphQ[GraphData[{"QuarticTransitive",31}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"QuarticTransitive",31}&]

RootGraph[GraphData[{"QuarticTransitive",31}]]

Halin

GraphData[{"QuarticTransitive",31},"Halin"]

GraphData[{"QuarticTransitive",31},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"QuarticTransitive",31},"Rigid"]

GraphData[{"QuarticTransitive",31},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"QuarticTransitive",31},"Flexible"]

GraphData[{"QuarticTransitive",31},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",31},"LCF"]

GraphData[{"QuarticTransitive",31},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",31},"LCFSignature"]

GraphData[{"QuarticTransitive",31},"LCFNotations"]

GraphData[{"QuarticTransitive",31},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",31}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",31}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",31},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",31}],Debug->True]//Timing

GraphData[{"QuarticTransitive",31},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",31},"VertexList"],GraphData[{"QuarticTransitive",31},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",31}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",31}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"QuarticTransitive",31},"Matchstick"]

GraphData[{"QuarticTransitive",31},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",31},"Edges"]]

3D All

GraphData[{"QuarticTransitive",31},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",31},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",31},"Polyhedral"]

{"QuarticTransitive", 32} == {"Circulant", {14, {1, 6}}}

GraphData[{"QuarticTransitive",32},"StandardName"]

{"QuarticTransitive", 33} == {"Circulant", {15, {3, 5}}}

GraphData[{"QuarticTransitive",33},"StandardName"]

{"QuarticTransitive", 34} == {"Circulant", {15, {1, 3}}}

GraphData[{"QuarticTransitive",34},"StandardName"]

{"QuarticTransitive", 35} == {"Circulant", {15, {1, 2}}}

GraphData[{"QuarticTransitive",35},"StandardName"]

{"QuarticTransitive", 36} == {"Circulant", {15, {1, 6}}}

GraphData[{"QuarticTransitive",36},"StandardName"]

{"QuarticTransitive", 37} == {"Circulant", {15, {1, 5}}}

GraphData[{"QuarticTransitive",37},"StandardName"]

{"QuarticTransitive", 38} == {"Circulant", {15, {1, 4}}}

GraphData[{"QuarticTransitive",38},"StandardName"]

{"QuarticTransitive", 39} == "PetersenLineGraph"

GraphData[{"QuarticTransitive",39},"StandardName"]

{"QuarticTransitive", 40}

Names

GraphData[{"QuarticTransitive",40},"StandardName"]

GraphData[{"QuarticTransitive",40},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",40}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[14],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,15},{2,4},{2,6},{2,16},{3,4},{3,7},{3,13},{4,8},{4,14},{5,6},{5,7},{5,10},{6,8},{6,9},{7,9},{7,12},{8,10},{8,11},{9,11},{9,13},{10,12},{10,14},{11,12},{11,15},{12,16},{13,14},{13,15},{14,16},{15,16}},VertexCoordinates->(10^(-4)){{8262,-16449},{8262,-4420},{10614,-18803},{10614,-2066},{12608,-12099},{12608,-8770},{14961,-14453},{14961,-6416},{18288,-14453},{18288,-6416},{20641,-12099},{20641,-8770},{22635,-18803},{22635,-2066},{24987,-16449},{24987,-4420}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",40},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",40},"Edges"]

v=Join[c=CirclePoints[8],c[[#]]+2/3(c[[#]]-c[[#2]])&@@@{{4,7},{3,8},{5,2},{6,1},{7,4},{8,3},{1,6},{2,5}}]/2;
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[15,16,10,9,11,12,13,14,15,1,6,12],e[11,5,2,16],e[13,7,4,9],e[14,8,3,10],{12,10},{9,15},{13,16},{11,14},e[{1,8},1]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",40},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",40},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",40},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",40},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",40},"Planar"]

GraphData[{"QuarticTransitive",40},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",40},{"RCN","CN"}]

GraphData[{"QuarticTransitive",40},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",40}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",40}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",40}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

GraphPlot@RotateGraph[,Pi/4]

{#+1,#2}&@@@{{-1,0},{8,0},{1,1},{6,1},{2,2},{3,2},{4,2},{5,2},{3,3},{4,3},{2,4},{5,4},{1,5},{6,5},{-1,6},{8,6}}

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,Pi/4]

RegionIntersection[Line@v[[{2,8}]],Line@v[[{4,14}]]]

RegionIntersection[Line@v[[{9,15}]],Line@v[[{3,13}]]]

RegionIntersection[Line@v[[{1,7}]],Line@v[[{3,13}]]]

RegionIntersection[Line@v[[{4,14}]],Line@v[[{16,10}]]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

gs=UnlabelGraph/@{,}

Circulant

GraphData[{"QuarticTransitive",40},"Circulant"]

GraphData[{"QuarticTransitive",40},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",40},"Halin"]

GraphData[{"QuarticTransitive",40},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",40},"LCF"]

GraphData[{"QuarticTransitive",40},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",40},"LCFSignature"]

GraphData[{"QuarticTransitive",40},"LCFNotations"]

GraphData[{"QuarticTransitive",40},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",40}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",40}],All])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

Manually rotate:

gs={LCFGraph[Sequence@@LCFNotation[],3],LCFGraph[Sequence@@LCFNotation[],-1]}

UnitDistance

GraphData[{"QuarticTransitive",40},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",40}],Debug->True]//Timing

GraphData[{"QuarticTransitive",40},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"QuarticTransitive",40},"Matchstick"]

GraphData[{"QuarticTransitive",40},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",40},"Edges"]]

3D All

GraphData[{"QuarticTransitive",40},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",40},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",40},"Polyhedral"]

GraphData[{"QuarticTransitive",40},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 41} == {"Circulant", {16, {1, 4}}}

GraphData[{"QuarticTransitive",41},"StandardName"]

{"QuarticTransitive", 42} == {"Circulant", {16, {1, 6}}}

GraphData[{"QuarticTransitive",42},"StandardName"]

{"QuarticTransitive", 43} == {"Circulant", {16, {1, 3}}}

GraphData[{"QuarticTransitive",43},"StandardName"]

{"QuarticTransitive", 44}

Names

GraphData[{"QuarticTransitive",44},"StandardName"]

GraphData[{"QuarticTransitive",44},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",44}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=IndexGraph@ContractCoincidentVertices[Graph[Range[22],UndirectedEdge@@@{{1,2},{1,3},{1,7},{1,18},{2,4},{2,8},{2,17},{3,10},{3,13},{3,19},{4,9},{4,14},{4,20},{5,6},{5,11},{5,22},{6,12},{8,21},{11,13},{11,19},{12,14},{12,20},{13,17},{13,20},{14,18},{14,19},{15,21},{16,22},{17,18},{19,21},{20,22},{21,22}},VertexCoordinates->(10^(-4)){{10062,-14668},{10062,-6201},{12394,-17002},{12394,-3868},{12608,-12099},{12608,-8770},{12619,-12109},{12619,-8760},{14951,-14443},{14951,-6426},{14961,-14453},{14961,-6416},{18288,-14453},{18288,-6416},{20630,-12109},{20630,-8760},{20641,-12099},{20641,-8770},{20855,-17002},{20855,-3868},{23187,-14668},{23187,-6201}},VertexLabels->Automatic],Tolerance->.1]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",44},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",44},"Edges"]

v=With[{q=Pi/3},Join[CirclePoints[{1,Pi/2-q},4],CirclePoints[{1,Pi/2+q},4],CirclePoints[2/3,8]]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,8,2,5,3,6,4,7,1,15,3,11,1],e[7,10,5,14,7],e[6,13,12,11,10,9,16,15,14,13,8,9,6],e[4,16,2,12,4]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",44},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",44},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",44},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",44},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",44},"Planar"]

GraphData[{"QuarticTransitive",44},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",44},{"RCN","CN"}]

GraphData[{"QuarticTransitive",44},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",44}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",44}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",44}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"QuarticTransitive",44}],"CrossingNumber"->cn,RandomSeed->i],{i,250}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",44},"Circulant"]

GraphData[{"QuarticTransitive",44},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",44},"Halin"]

GraphData[{"QuarticTransitive",44},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",44},"LCF"]

GraphData[{"QuarticTransitive",44},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",44},"LCFSignature"]

GraphData[{"QuarticTransitive",44},"LCFNotations"]

GraphData[{"QuarticTransitive",44},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",44}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",44}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",44},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",44}],Debug->True]//Timing

GraphData[{"QuarticTransitive",44},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine/@GraphData[{"QuarticTransitive",44},"Graph","All"]

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistanceEmbeddingRefine/@Complement@@(GraphData[{"QuarticTransitive",44},"Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

g=RotateGraph[LabelGraph@,{4,3}]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",44}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",44}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",44}],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData[{"QuarticTransitive",44},"Matchstick"]

GraphData[{"QuarticTransitive",44},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",44},"Edges"]]

3D All

GraphData[{"QuarticTransitive",44},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",44},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",44},"Polyhedral"]

GraphData[{"QuarticTransitive",44},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 45}

Names

GraphData[{"QuarticTransitive",45},"StandardName"]

GraphData[{"QuarticTransitive",45},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",45}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[16],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,15},{2,4},{2,6},{2,16},{3,4},{3,7},{3,13},{4,8},{4,14},{5,7},{5,8},{5,11},{6,7},{6,8},{6,12},{7,9},{8,10},{9,11},{9,12},{9,13},{10,11},{10,12},{10,14},{11,15},{12,16},{13,14},{13,15},{14,16},{15,16}},VertexCoordinates->(10^(-4))/2{{8850,-45087},{8850,-13545},{16680,-52919},{16680,-5713},{19082,-34853},{19082,-23779},{26912,-42685},{26912,-15947},{37986,-42685},{37986,-15947},{45816,-34853},{45816,-23779},{48218,-52919},{48218,-5713},{56048,-45087},{56048,-13545}}]

RecognizeGraph[g]

All

GraphData[{"QuarticTransitive",45},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",45},"Edges"]

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

RecognizeGraph[g]

v=Join[c=CirclePoints[8],c[[#]]+2/3(c[[#]]-c[[#2]])&@@@{{4,7},{3,8},{5,2},{6,1},{7,4},{8,3},{1,6},{2,5}}]/2;
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[15,16,10,9,11,12,13,14,15,1],e[6,12],e[11,5],e[2,16],e[13,7],e[4,9],e[14,8],e[3,10],{12,10},{9,15},{13,16},{11,14},e[7,2,1,8,7,5,4,3,6,5],{6,8},{2,4},{1,3}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",45},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",45},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",45},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",45},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",45},"Planar"]

GraphData[{"QuarticTransitive",45},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",45},{"RCN","CN"}]

GraphData[{"QuarticTransitive",45},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",45}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",45}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",45}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

GraphPlot@RotateGraph[,-Pi/4]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,-Pi/4]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

gs=UnlabelGraph/@{}

Circulant

GraphData[{"QuarticTransitive",45},"Circulant"]

GraphData[{"QuarticTransitive",45},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",45},"Halin"]

GraphData[{"QuarticTransitive",45},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",45},"LCF"]

GraphData[{"QuarticTransitive",45},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",45},"LCFSignature"]

GraphData[{"QuarticTransitive",45},"LCFNotations"]

GraphData[{"QuarticTransitive",45},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",45}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",45}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

gs

gs={LCFGraph[Sequence@@LCFNotation[],-1],,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,}

UnitDistance

GraphData[{"QuarticTransitive",45},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",45}],Debug->True]//Timing

GraphData[{"QuarticTransitive",45},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",45},"VertexList"],GraphData[{"QuarticTransitive",45},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",45}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",45}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"QuarticTransitive",45},"Matchstick"]

GraphData[{"QuarticTransitive",45},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",45},"Edges"]]

3D All

GraphData[{"QuarticTransitive",45},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",45},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",45},"Polyhedral"]

GraphData[{"QuarticTransitive",45},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 46} == {"Antiprism", 8}

GraphData[{"QuarticTransitive",46},"StandardName"]

{"QuarticTransitive", 47}

Names

GraphData[{"QuarticTransitive",47},"StandardName"]

GraphData[{"QuarticTransitive",47},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",47}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[15],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,15},{2,4},{2,6},{2,16},{3,4},{3,7},{3,13},{4,8},{4,14},{5,7},{5,8},{5,9},{6,7},{6,8},{6,10},{7,11},{8,12},{9,11},{9,12},{9,13},{10,11},{10,12},{10,14},{11,15},{12,16},{13,14},{13,15},{14,16},{15,16}},VertexCoordinates->(10^(-4)){{8262,-16449},{8262,-4420},{10614,-18803},{10614,-2066},{12608,-12099},{12608,-8770},{14961,-14453},{14961,-6416},{18288,-14453},{18288,-6416},{20641,-12099},{20641,-8770},{22635,-18803},{22635,-2066},{24987,-16449},{24987,-4420}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",47},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",47},"Edges"]

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

RecognizeGraph[g]

v=Join[c=CirclePoints[8],c[[#]]+2/3(c[[#]]-c[[#2]])&@@@{{4,7},{3,8},{5,2},{6,1},{7,4},{8,3},{1,6},{2,5}}]/2;
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[15,16,10,9,11,12,13,14,15,1],e[6,12],e[11,5],e[2,16],e[13,7],e[4,9],e[14,8],e[3,10],{12,10},{9,15},{13,16},{11,14},e[1,3,5,7,1,2,4,6,8,2],{5,6},{7,8},{3,4}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",47},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",47},"Graph","Degenerate"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",47},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",47},"Planar"]

GraphData[{"QuarticTransitive",47},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",47},{"RCN","CN"}]

GraphData[{"QuarticTransitive",47},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",47}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",47}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",47}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

RotateGraph[#,Pi/4]&/@Table[MinimalCrossingGraph[GraphData[{"QuarticTransitive",47}],"CrossingNumber"->cn,RandomSeed->i],{i,500}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",47},"Circulant"]

GraphData[{"QuarticTransitive",47},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",47},"Halin"]

GraphData[{"QuarticTransitive",47},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",47},"LCF"]

GraphData[{"QuarticTransitive",47},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",47},"LCFSignature"]

GraphData[{"QuarticTransitive",47},"LCFNotations"]

GraphData[{"QuarticTransitive",47},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",47}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",47}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",47},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",47}],Debug->True]//Timing

GraphData[{"QuarticTransitive",47},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",47},"VertexList"],GraphData[{"QuarticTransitive",47},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

LabelGraph@

ContractCoincidentVertices@%

RecognizeGraph@%

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",47}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",47}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"QuarticTransitive",47},"Matchstick"]

GraphData[{"QuarticTransitive",47},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",47},"Edges"]]

3D All

GraphData[{"QuarticTransitive",47},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",47},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",47},"Polyhedral"]

GraphData[{"QuarticTransitive",47},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 48}

Names

GraphData[{"QuarticTransitive",48},"StandardName"]

GraphData[{"QuarticTransitive",48},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",48}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[16],UndirectedEdge@@@{{1,2},{1,3},{1,6},{1,15},{2,4},{2,5},{2,16},{3,4},{3,9},{3,13},{4,10},{4,14},{5,6},{5,7},{5,11},{6,8},{6,12},{7,8},{7,9},{7,13},{8,10},{8,14},{9,10},{9,11},{10,12},{11,12},{11,16},{12,15},{13,14},{13,15},{14,16},{15,16}},VertexCoordinates->(10^(-4)){{8262,-16449},{8262,-4420},{10614,-18803},{10614,-2066},{12608,-12099},{12608,-8770},{14961,-14453},{14961,-6416},{18288,-14453},{18288,-6416},{20641,-12099},{20641,-8770},{22635,-18803},{22635,-2066},{24987,-16449},{24987,-4420}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",48},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",48},"Edges"]

v=Join[CirclePoints[10],CirclePoints[2/3,6]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[10,1,3,4,6,5,7,8,10,2,3,5,13,14,6,8,9,1,11,16,10],e[16,7,15,9,14,12,16],e[13,15,11,4,12,2,13]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",48},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",48},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",48},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",48},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",48},"Planar"]

GraphData[{"QuarticTransitive",48},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",48},{"RCN","CN"}]

GraphData[{"QuarticTransitive",48},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",48}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",48}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",48}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",48},"Circulant"]

GraphData[{"QuarticTransitive",48},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",48},"Halin"]

GraphData[{"QuarticTransitive",48},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",48},"LCF"]

GraphData[{"QuarticTransitive",48},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",48},"LCFSignature"]

GraphData[{"QuarticTransitive",48},"LCFNotations"]

GraphData[{"QuarticTransitive",48},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",48}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",48}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",48},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",48}],Debug->True]//Timing

GraphData[{"QuarticTransitive",48},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",48},"VertexList"],GraphData[{"QuarticTransitive",48},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",48}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",48}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"QuarticTransitive",48},"Matchstick"]

GraphData[{"QuarticTransitive",48},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",48},"Edges"]]

3D All

GraphData[{"QuarticTransitive",48},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",48},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",48},"Polyhedral"]

GraphData[{"QuarticTransitive",48},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 49}

Names

GraphData[{"QuarticTransitive",49},"StandardName"]

GraphData[{"QuarticTransitive",49},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",49}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[16],UndirectedEdge@@@{{1,2},{1,4},{1,5},{1,16},{2,3},{2,7},{2,15},{3,11},{3,12},{3,14},{4,8},{4,10},{4,13},{5,9},{5,12},{5,14},{6,7},{6,8},{6,11},{6,14},{7,10},{7,13},{8,9},{8,12},{9,11},{9,13},{10,11},{10,15},{12,16},{13,16},{14,15},{15,16}},VertexCoordinates->(10^(-4)){{7057,-13708},{7057,-7061},{10378,-10385},{11753,-18408},{11753,-13708},{11753,-7061},{11753,-2361},{15075,-15084},{15075,-5685},{18396,-18408},{18396,-13708},{18396,-7061},{18396,-2361},{19771,-10385},{23092,-13708},{23092,-7061}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",49},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",49},"Edges"]

v=Join[CirclePoints[8],CirclePoints[{1/2,-Pi/2},8]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[{1,8},1,10,13,16,11,14,9,12,15,10,14,5,1],e[13,4,8,9,13],e[16,12,3,7,16],e[15,11],e[11,2,6,15]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",49},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",49},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",49},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",49},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",49},"Planar"]

GraphData[{"QuarticTransitive",49},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",49},{"RCN","CN"}]

GraphData[{"QuarticTransitive",49},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",49}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",49}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",49}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

RotateGraph[#,Pi/4]&/@Table[MinimalCrossingGraph[GraphData[{"QuarticTransitive",49}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",49},"Circulant"]

GraphData[{"QuarticTransitive",49},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",49},"Halin"]

GraphData[{"QuarticTransitive",49},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",49},"LCF"]

GraphData[{"QuarticTransitive",49},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",49},"LCFSignature"]

GraphData[{"QuarticTransitive",49},"LCFNotations"]

GraphData[{"QuarticTransitive",49},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",49}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",49}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",49},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",49}],Debug->True]//Timing

GraphData[{"QuarticTransitive",49},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",49},"VertexList"],GraphData[{"QuarticTransitive",49},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",49}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",49}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"QuarticTransitive",49},"Matchstick"]

GraphData[{"QuarticTransitive",49},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",49},"Edges"]]

3D All

GraphData[{"QuarticTransitive",49},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",49},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",49},"Polyhedral"]

GraphData[{"QuarticTransitive",49},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 50}

Names

GraphData[{"QuarticTransitive",50},"StandardName"]

GraphData[{"QuarticTransitive",50},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",50}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[16],UndirectedEdge@@@{{1,2},{1,3},{1,5},{1,7},{2,4},{2,6},{2,8},{3,5},{3,7},{3,13},{4,6},{4,8},{4,14},{5,6},{5,7},{6,8},{7,9},{8,10},{9,11},{9,13},{9,15},{10,12},{10,14},{10,16},{11,12},{11,13},{11,15},{12,14},{12,16},{13,15},{14,16},{15,16}},VertexCoordinates->(10^(-4)){{8262,-16449},{8262,-4420},{10614,-18803},{10614,-2066},{12608,-12099},{12608,-8770},{14961,-14453},{14961,-6416},{18288,-14453},{18288,-6416},{20641,-12099},{20641,-8770},{22635,-18803},{22635,-2066},{24987,-16449},{24987,-4420}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",50},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",50},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",50},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",50},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",50},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",50},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",50},"Planar"]

GraphData[{"QuarticTransitive",50},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",50},{"RCN","CN"}]

GraphData[{"QuarticTransitive",50},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",50}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",50}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",50}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

GraphPlot@

v=With[{r=3/2},Delete[Flatten[Table[Append[CirclePoints[{i,j},{1,0},4],{i,j}],{i,r{-1,1}},{j,r{-1,1}}],2],List/@{2,15,6,19}]];
v[[8]]=Mean[v[[{6,8}]]];
v[[4]]=Mean[v[[{3,4}]]];
v[[16]]=Mean[v[[{16,14}]]];
g=Graph[Range@Length@v,UndirectedEdge@@@{e[9,13,14,5,6,2,3,12,9,11,1,4,2],e[3,4,7,5],e[6,8,15,16,13],e[6,7,8,5],e[3,1,2],e[12,10,16,14,15],{13,15,15},e[12,11,10,9]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

RotateGraph[#,-.4]&/@(Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData[{"QuarticTransitive",50}],"CrossingNumber"->cn,RandomSeed->n]],{n,500}],Max[OuterFace[#]]<=GraphData[{"QuarticTransitive",50},"V"]&]])//Timing

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",50},"Circulant"]

GraphData[{"QuarticTransitive",50},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",50},"Halin"]

GraphData[{"QuarticTransitive",50},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",50},"LCF"]

GraphData[{"QuarticTransitive",50},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",50},"LCFSignature"]

GraphData[{"QuarticTransitive",50},"LCFNotations"]

GraphData[{"QuarticTransitive",50},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",50}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",50}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",50},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",50}],Debug->True]//Timing

GraphData[{"QuarticTransitive",50},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"QuarticTransitive",50},"Matchstick"]

GraphData[{"QuarticTransitive",50},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",50},"Edges"]]

g=EdgeAdd[GraphData[{"Prism",8},"Graph",{"Labeled","3D"}],UndirectedEdge@@@{{7,14},{6,15},{5,12},{4,13},{2,11},{3,10},{1,16},{8,9}}]

RecognizeGraph[g]

3D All

GraphData[{"QuarticTransitive",50},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",50},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",50},"Polyhedral"]

GraphData[{"QuarticTransitive",50},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 51} == "TesseractGraph"

GraphData[{"QuarticTransitive",51},"StandardName"]

{"QuarticTransitive", 52} == {"Circulant", {16, {1, 7}}}

GraphData[{"QuarticTransitive",52},"StandardName"]

{"QuarticTransitive", 53} == {"Circulant", {17, {1, 3}}}

GraphData[{"QuarticTransitive",53},"StandardName"]

{"QuarticTransitive", 54} == {"Circulant", {17, {1, 5}}}

GraphData[{"QuarticTransitive",54},"StandardName"]

{"QuarticTransitive", 55} == {"Circulant", {17, {1, 2}}}

GraphData[{"QuarticTransitive",55},"StandardName"]

{"QuarticTransitive", 56} == {"Circulant", {17, {1, 4}}}

GraphData[{"QuarticTransitive",56},"StandardName"]

{"QuarticTransitive", 57}

Names

GraphData[{"QuarticTransitive",57},"StandardName"]

GraphData[{"QuarticTransitive",57},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",57}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[18],UndirectedEdge@@@{{1,2},{1,3},{1,7},{1,14},{2,4},{2,8},{2,13},{3,4},{3,5},{3,17},{4,6},{4,18},{5,7},{5,10},{5,11},{6,8},{6,9},{6,12},{7,9},{7,16},{8,10},{8,15},{9,11},{9,15},{10,12},{10,16},{11,12},{11,13},{12,14},{13,15},{13,18},{14,16},{14,17},{15,17},{16,18},{17,18}},VertexCoordinates->(10^(-4)){{8425,-9685},{8874,-12234},{8874,-7135},{10168,-14476},{10168,-4893},{12150,-16141},{12150,-3229},{14581,-17026},{14581,-2343},{17168,-17026},{17168,-2343},{19599,-16141},{19599,-3229},{21581,-14476},{21581,-4893},{22875,-12234},{22875,-7135},{23324,-9685}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",57},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",57},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",57},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",57},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"QuarticTransitive",57},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",57},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",57},"Planar"]

GraphData[{"QuarticTransitive",57},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",57},{"RCN","CN"}]

GraphData[{"QuarticTransitive",57},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",57}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",57}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",57}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",57},"Circulant"]

GraphData[{"QuarticTransitive",57},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",57},"Halin"]

GraphData[{"QuarticTransitive",57},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",57},"LCF"]

GraphData[{"QuarticTransitive",57},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",57},"LCFSignature"]

GraphData[{"QuarticTransitive",57},"LCFNotations"]

GraphData[{"QuarticTransitive",57},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",57}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",57}],All])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,XXX}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",57},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",57}],Debug->True]//Timing

GraphData[{"QuarticTransitive",57},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"QuarticTransitive",57},"Matchstick"]

GraphData[{"QuarticTransitive",57},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",57},"Edges"]]

3D All

GraphData[{"QuarticTransitive",57},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",57},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",57},"Polyhedral"]

GraphData[{"QuarticTransitive",57},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 58} == {"Antiprism", 9}

GraphData[{"QuarticTransitive",58},"StandardName"]

{"QuarticTransitive", 59}

Names

GraphData[{"QuarticTransitive",59},"StandardName"]

GraphData[{"QuarticTransitive",59},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",59}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[18],UndirectedEdge@@@{{1,2},{1,3},{1,4},{1,5},{2,3},{2,6},{2,16},{3,7},{3,17},{4,6},{4,8},{4,14},{5,7},{5,9},{5,15},{6,8},{6,11},{7,9},{7,10},{8,10},{8,13},{9,11},{9,12},{10,12},{10,14},{11,13},{11,15},{12,14},{12,16},{13,15},{13,17},{14,18},{15,18},{16,17},{16,18},{17,18}},VertexCoordinates->(10^(-4)){{8823,-10460},{11768,-11787},{11768,-9132},{12771,-17301},{12771,-3618},{13094,-14086},{13094,-6833},{15391,-15413},{15391,-5506},{18044,-15413},{18044,-5506},{20341,-14086},{20341,-6833},{20665,-17301},{20665,-3618},{21668,-11787},{21668,-9132},{24612,-10460}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",59},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",59},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",59},"Edges"]

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

RecognizeGraph[g]

GraphPlot@GraphData[{"QuarticTransitive",59},"Edges"]

RotateGraph[GraphicsToGraph@,.55]

v=Join[CirclePoints[9],CirclePoints[{1/2,-Pi/2},9]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{Sequence@@Partition[Range[9],2,1,1],e[8,18,10,11,2],e[8,17,16,15,5,14,13,12,2],{17,18},{11,12},{14,15},e[9,10,1],e[3,13,4],e[7,16,6],{9,14},{1,15},{3,17},{4,18},{7,12},{6,11}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

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

RecognizeGraph@g

Degenerate

GraphData[{"QuarticTransitive",59},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"QuarticTransitive",59},"Graph","Degenerate"]

Bilateral

GraphData[{"QuarticTransitive",59},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",59},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",59},"Planar"]

GraphData[{"QuarticTransitive",59},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",59},{"RCN","CN"}]

GraphData[{"QuarticTransitive",59},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",59}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",59}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",59}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

GraphPlot@RotateGraph[,Pi-Pi/6]

Subdivide[-1/2,1/2,6]

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

RecognizeGraph@g

RectilinearCrossingCount@g

GraphPlot@

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

RecognizeGraph@g

RectilinearCrossingCount@g

GraphPlot@

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

RecognizeGraph@g

RectilinearCrossingCount@g

GraphPlot@

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

RecognizeGraph@g

RectilinearCrossingCount@g

GraphPlot@RotateGraph[,-2Pi/3]

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

RecognizeGraph@g

RectilinearCrossingCount@g

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

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

GraphPlot@

v[[11]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

gs=UnlabelGraph/@{,,,,,}

Circulant

GraphData[{"QuarticTransitive",59},"Circulant"]

GraphData[{"QuarticTransitive",59},"Graph","Circulant"]//StyleGraphs

Line graph

GraphData[{"QuarticTransitive",59},"Line"]

LineGraphQ[GraphData[{"QuarticTransitive",59}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"QuarticTransitive",59}&]

RootGraph[GraphData[{"QuarticTransitive",59}]]

Halin

GraphData[{"QuarticTransitive",59},"Halin"]

GraphData[{"QuarticTransitive",59},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"QuarticTransitive",59},"Rigid"]

GraphData[{"QuarticTransitive",59},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"QuarticTransitive",59},"Flexible"]

GraphData[{"QuarticTransitive",59},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",59},"LCF"]

GraphData[{"QuarticTransitive",59},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",59},"LCFSignature"]

GraphData[{"QuarticTransitive",59},"LCFNotations"]

GraphData[{"QuarticTransitive",59},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",59}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",59}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",59},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",59}],Debug->True]//Timing

GraphData[{"QuarticTransitive",59},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance construction

Show[g1=CenterGraph[RotateGraph[,{14,10}]],Axes->True]

EdgeLengths[g1]

g2=UnitDistanceEmbeddingRefine[g1,PrecisionGoal->200,AccuracyGoal->50]

EdgeLengths[g2]

v=GraphEmbedding[g2]

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",59},"VertexList"],GraphData[{"QuarticTransitive",59},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",59}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",59}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData[{"QuarticTransitive",59},"Matchstick"]

GraphData[{"QuarticTransitive",59},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",59},"Edges"]]

3D All

GraphData[{"QuarticTransitive",59},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",59},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",59},"Polyhedral"]

{"QuarticTransitive", 60} == {"Circulant", {18, {1, 5}}}

GraphData[{"QuarticTransitive",60},"StandardName"]

{"QuarticTransitive", 61} == {"Circulant", {18, {2, 3}}}

GraphData[{"QuarticTransitive",61},"StandardName"]

{"QuarticTransitive", 62} == {"Circulant", {18, {1, 3}}}

GraphData[{"QuarticTransitive",62},"StandardName"]

{"QuarticTransitive", 63} == {"Circulant", {18, {1, 4}}}

GraphData[{"QuarticTransitive",63},"StandardName"]

{"QuarticTransitive", 64} == {"Circulant", {18, {1, 6}}}

GraphData[{"QuarticTransitive",64},"StandardName"]

{"QuarticTransitive", 65} == {"TorusGrid", {3, 6}}

GraphData[{"QuarticTransitive",65},"StandardName"]

{"QuarticTransitive", 66}

Names

GraphData[{"QuarticTransitive",66},"StandardName"]

GraphData[{"QuarticTransitive",66},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",66}]//StyleGraphs[#,ImageSize->Small]&

Inexact

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

Read and Wilson construction

g=Graph[Range[18],UndirectedEdge@@@{{1,2},{1,3},{1,7},{1,13},{2,4},{2,6},{2,8},{3,4},{3,12},{3,14},{4,5},{4,11},{5,6},{5,9},{5,16},{6,10},{6,18},{7,8},{7,9},{7,16},{8,10},{8,15},{9,11},{9,13},{10,12},{10,14},{11,12},{11,17},{12,18},{13,14},{13,17},{14,15},{15,16},{15,17},{16,18},{17,18}},VertexCoordinates->(10^(-4)){{4548,-10512},{7387,-8871},{10226,-20354},{10226,-17073},{10226,-13792},{10226,-7231},{10226,-669},{13066,-2309},{15905,-17073},{15905,-3950},{18745,-18714},{21584,-20354},{21584,-13792},{21584,-7231},{21584,-3950},{21584,-669},{24423,-12152},{27263,-10512}}]

All

GraphData[{"QuarticTransitive",66},"Graph","All"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",66},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",66},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",66},"Graph","Degenerate"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",66},"Graph","Circular"]//StyleGraphs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"QuarticTransitive",66},{"RCN","CN"}]

GraphData[{"QuarticTransitive",66},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",66}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",66}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",66}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

g=RotateGraph[MinimalCrossingGraph[GraphData[{"QuarticTransitive",66}],"CrossingNumber"->cn]]

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

GraphPlot@

RecognizeGraph[g]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",66},"Circulant"]

GraphData[{"QuarticTransitive",66},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",66},"Halin"]

GraphData[{"QuarticTransitive",66},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",66},"LCF"]

GraphData[{"QuarticTransitive",66},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",66},"LCFSignature"]

GraphData[{"QuarticTransitive",66},"LCFNotations"]

GraphData[{"QuarticTransitive",66},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",66}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",66}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",66},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",66}],Debug->True]//Timing

GraphData[{"QuarticTransitive",66},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine/@GraphData[{"QuarticTransitive",66},"Graph","All"]

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistanceEmbeddingRefine/@Complement@@(GraphData[{"QuarticTransitive",66},"Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",66}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",66}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",66}],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData[{"QuarticTransitive",66},"Matchstick"]

GraphData[{"QuarticTransitive",66},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",66},"Edges"]]

3D All

GraphData[{"QuarticTransitive",66},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",66},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",66},"Polyhedral"]

GraphData[{"QuarticTransitive",66},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 67}

Names

GraphData[{"QuarticTransitive",67},"StandardName"]

GraphData[{"QuarticTransitive",67},"StandardNames"]

Primary

GraphData[{"QuarticTransitive",67}]//StyleGraphs[#,ImageSize->Small]&

Read and Wilson construction

g=Graph[Range[18],UndirectedEdge@@@{{1,2},{1,3},{1,10},{1,15},{2,4},{2,9},{2,16},{3,5},{3,12},{3,13},{4,6},{4,11},{4,14},{5,6},{5,7},{5,18},{6,8},{6,17},{7,8},{7,9},{7,17},{8,10},{8,18},{9,11},{9,14},{10,12},{10,13},{11,13},{11,16},{12,14},{12,15},{13,15},{14,16},{15,17},{16,18},{17,18}},VertexCoordinates->(10^(-4)){{8425,-9685},{8874,-12234},{8874,-7135},{10168,-14476},{10168,-4893},{12150,-16141},{12150,-3229},{14581,-17026},{14581,-2343},{17168,-17026},{17168,-2343},{19599,-16141},{19599,-3229},{21581,-14476},{21581,-4893},{22875,-12234},{22875,-7135},{23324,-9685}}]

RecognizeGraph@g

All

GraphData[{"QuarticTransitive",67},"Graph","All"]//StyleGraphs

Inexact

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

Default embedding

GraphPlot@GraphData[{"QuarticTransitive",67},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"QuarticTransitive",67},"EdgeList"]]

Degenerate

GraphData[{"QuarticTransitive",67},"Graph","Degenerate"]//StyleGraphs

Circular

GraphData[{"QuarticTransitive",67},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"QuarticTransitive",67},"Planar"]

GraphData[{"QuarticTransitive",67},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"QuarticTransitive",67},{"RCN","CN"}]

GraphData[{"QuarticTransitive",67},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"QuarticTransitive",67}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"QuarticTransitive",67}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"QuarticTransitive",67}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

GraphData[{"QuarticTransitive",67},"V"]

GraphPlot@RotateGraph[,-Pi/2]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"QuarticTransitive",67},"Circulant"]

GraphData[{"QuarticTransitive",67},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"QuarticTransitive",67},"Halin"]

GraphData[{"QuarticTransitive",67},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"QuarticTransitive",67},"LCF"]

GraphData[{"QuarticTransitive",67},"HamiltonianCycleCount"]

GraphData[{"QuarticTransitive",67},"LCFSignature"]

GraphData[{"QuarticTransitive",67},"LCFNotations"]

GraphData[{"QuarticTransitive",67},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"QuarticTransitive",67}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"QuarticTransitive",67}],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"QuarticTransitive",67},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"QuarticTransitive",67}],Debug->True]//Timing

GraphData[{"QuarticTransitive",67},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"QuarticTransitive",67},"VertexList"],GraphData[{"QuarticTransitive",67},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"QuarticTransitive",67}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData[{"QuarticTransitive",67},"Matchstick"]

GraphData[{"QuarticTransitive",67},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"QuarticTransitive",67},"Edges"]]

3D All

GraphData[{"QuarticTransitive",67},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"QuarticTransitive",67},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"QuarticTransitive",67},"Polyhedral"]

GraphData[{"QuarticTransitive",67},"Graph",{"3D","Polyhedron"}]

{"QuarticTransitive", 68} == {"Circulant", {18, {1, 8}}}

GraphData[{"QuarticTransitive",68},"StandardName"]

{"QuarticTransitive", 69} == {"Circulant", {19, {1, 2}}}

GraphData[{"QuarticTransitive",69},"StandardName"]

{"QuarticTransitive", 70} == {"Circulant", {19, {1, 3}}}

GraphData[{"QuarticTransitive",70},"StandardName"]

{"QuarticTransitive", 71} == {"Circulant", {19, {1, 4}}}

GraphData[{"QuarticTransitive",71},"StandardName"]

{"QuarticTransitive", 72} == {"Circulant", {19, {1, 7}}}

GraphData[{"QuarticTransitive",72},"StandardName"]