Biggest Little Polygon

Author

Eric W. Weisstein
September 14, 2024

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

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

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

Configurations

BLP[6]:=With[{x=,y=,bb=},{{0,0},{(1/2),-y},{x,-bb},{0,-1},{-x,-bb},{-(1/2),-y}}]
BLP[8]:=({#1,-#2}&)@@@{{0,0},{-.40980,.22442},{-.5,.63947},{-.26214,.96503},{0,1},{.26214,.96503},{.5,.63947},{.40980,.22442}};

BiggestLittlePolygon[n_]:=Graph[Range[n],UndirectedEdge@@@Sort[Sort/@Join[Select[Subsets[Range[n],{2}],(Abs[Norm[Subtract@@(BLP[n][[#]])]-1.]<.001)&],Partition[Range[n],2,1,1]]],VertexCoordinates->BLP[n]]

BiggestLittlePolygon/@{6,8}

Areas

v=GraphData[{"BiggestLittlePolygon", 6},"VertexCoordinates"]

A111969

Area[ConvexHullRegion[v]]//FullSimplify

N[%,20]

RealDigits[Root[11993-78488 #+144464 #^2+1232 #^3-221360 #^4+146496 #^5+21056 #^6-30848 #^7-3008 #^8+8192 #^9+4096 #^10&,5],10,100][[1]]

8

v=GraphData[{"BiggestLittlePolygon", 8},"VertexCoordinates"]

Area[ConvexHullRegion[v]]

% larger than regular n-gon

((100(#-#2))/(#2))&@@@Table[{Abs[Area[Evaluate[Polygon[BLP[n]]]]],(1/2) n (R^2) Sin[((2 π)/n)]/.R->1/2},{n,{6,8}}]//RootReduce

N[%,10]

Plot

MakeBoxes[label[n_],TraditionalForm]:=SubsuperscriptBox["A",MakeBoxes[n,TraditionalForm],"*"]

GraphicsRow[
Graphics[{
ClosedLine[BLP[#]],
{
Red,
Line/@Select[Subsets[BLP[#],{2}],(Abs[Norm[Subtract@@#]-1.]<.001)&]
}
},AspectRatio->Automatic,PlotLabel->Style[TraditionalForm[label[#]==Abs[Area[Evaluate[Polygon[BLP[#]//N]]]]],Directive[18,FontFamily->"Times"]]]&/@{6,8},LabelStyle->FontFamily->"Times"]

Optimization

Audet, C.; Hansen, P.; Messine, F.; and Xiong, J.  "The Largest Small Octagon."  J. Combin. Th. Ser. A 98, 46–59, 2002.

https://doi.org/10.1006/jcta.2001.3225

(CanvasOverlay[(CanvasFrame), ])

audetpts=Flatten[{#,Sqrt[1-#^2]}&[{0.26214,0.67194,0.67194,0.90980,0.90980}]];

consWrong={
(x1-x2)^2+(y1-y2)^2≤1,
(-x1+x3-x5)^2+(y1-y3+y5)^2≤1,
(x1-x2+x4)^2+(y1-y2+y4)^2≤1,
(-x1+x3)^2+(y1-y3)^2≤1,
(2x1-x2-x3+x5)^2+(-y2-y3-y5)^2≤1,(* incorrect -y3 should be +y3 *)
(2x1-x2)^2+y2^2≤1,
(x1-x2)^2+(y1-y2-1)^2≤1,
(2x1-x2-x3)^2+(-y2+y3)^2≤1,
(x3-x5)^2+(-y3+y5)^2≤1,
(-x1+x3-x5)^2+(y1-y3+y5-1)^2≤1,
(2x1+x3-x5)^2+(-y3+y5)^2≤1,
(2x1-x2-x3+x4+x5)^2+(-y2+y3+y4-y5)^2==1,
(-2x1+x2-x4)^2+(y2-y4)^2≤1,
(x1-x2+x4)^2+(y1-y2+y4-1)^2≤1,
(x1-x3)^2+(1-y1+y3)^2≤1,
(x2-x4)^2+(y2-y4)^2≤1,
(2x1-x3)^2+y3^2≤1,
(2x1-x2-x3+x4)^2+(-y2+y3+y4)^2≤1,
x2-x3≥0,
x1^2+y1^2==1,
x2^2+y2^2==1,
x3^2+y3^2==1,
x4^2+y4^2==1,
x5^2+y5^2==1,
0≤x1≤1/2,
0≤x2≤1,
0≤x3≤1,
0≤x4≤1,
0≤x5≤1};
vars={x1,x2,x3,x4,x5,y1,y2,y3,y4,y5};
f=(1/2)((x2+x3-4x1)y1+(3x1-2x3+x5)y2+(3x1-2x2+x4)y3+(x3-2x1)y4+(x2-2x1)y5)+x1;

The constraints are violated by the optimal points in the original paper:

Position[consWrong/.Thread[vars->audetpts],False]//Flatten

consWrong[[5]]

Should be:

{x1-x2,y1-y2}-{x3-x1-x5,y1-y3+y5}

so correct -y3 -> +y3

cons={
(x1-x2)^2+(y1-y2)^2≤1,
(-x1+x3-x5)^2+(y1-y3+y5)^2≤1,
(x1-x2+x4)^2+(y1-y2+y4)^2≤1,
(-x1+x3)^2+(y1-y3)^2≤1,
(2x1-x2-x3+x5)^2+(-y2+y3-y5)^2≤1,(* corrected -y3 -> +y3 *)
(2x1-x2)^2+y2^2≤1,
(x1-x2)^2+(y1-y2-1)^2≤1,
(2x1-x2-x3)^2+(-y2+y3)^2≤1,
(x3-x5)^2+(-y3+y5)^2≤1,
(-x1+x3-x5)^2+(y1-y3+y5-1)^2≤1,
(2x1+x3-x5)^2+(-y3+y5)^2≤1,
(2x1-x2-x3+x4+x5)^2+(-y2+y3+y4-y5)^2==1,
(-2x1+x2-x4)^2+(y2-y4)^2≤1,
(x1-x2+x4)^2+(y1-y2+y4-1)^2≤1,
(x1-x3)^2+(1-y1+y3)^2≤1,
(x2-x4)^2+(y2-y4)^2≤1,
(2x1-x3)^2+y3^2≤1,
(2x1-x2-x3+x4)^2+(-y2+y3+y4)^2≤1,
x2-x3≥0,
x1^2+y1^2==1,
x2^2+y2^2==1,
x3^2+y3^2==1,
x4^2+y4^2==1,
x5^2+y5^2==1,
0≤x1≤1/2,
0≤x2≤1,
0≤x3≤1,
0≤x4≤1,
0≤x5≤1};
vars={x1,x2,x3,x4,x5,y1,y2,y3,y4,y5};
f=(1/2)((x2+x3-4x1)y1+(3x1-2x3+x5)y2+(3x1-2x2+x4)y3+(x3-2x1)y4+(x2-2x1)y5)+x1;

And@@(cons/.Thread[vars->audetpts])

PrecisionGoal->MachinePrecision

(nsoln=NMaximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5}])//Timing

PrecisionGoal->6

(nsoln=NMaximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5},PrecisionGoal->6])//Timing

vars/.soln[[2]]

WorkingPrecision->100, PrecisionGoal->50

(nsoln=NMaximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5},WorkingPrecision->100,PrecisionGoal->50])//Timing

vals=nsoln[[2,All,2]]

rvals=RootApproximant/@vals

vals-rvals

WorkingPrecision->200, PrecisionGoal->100

(nsoln=NMaximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5},WorkingPrecision->200,PrecisionGoal->100,MaxIterations->1000])//Timing

vals=nsoln[[2,All,2]]

rvals=RootApproximant/@vals

vals-rvals

WorkingPrecision->500, PrecisionGoal->250

(nsoln=NMaximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5},WorkingPrecision->500,PrecisionGoal->250,MaxIterations->1000])//Timing

vals=nsoln[[2,All,2]]

rvals=RootApproximant/@vals

vals-rvals

(val=RootApproximant[nsoln[[1]]])//Timing

N[val,20]

WorkingPrecision->1000, PrecisionGoal->500

(nsoln=NMaximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5},WorkingPrecision->1000,PrecisionGoal->500,MaxIterations->1000])//Timing

vals=nsoln[[2,All,2]]

Precision/@vals

(rvals=RootApproximant/@vals)//Timing

vals-rvals

(rvals=RootApproximant/@N[vals,500])//Timing

vals-rvals//N[#,20]&

(val=RootApproximant[nsoln[[1]]])//Timing

N[val,20]

WorkingPrecision->2000, PrecisionGoal->1000

(nsoln=NMaximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5},WorkingPrecision->2000,PrecisionGoal->1000,MaxIterations->1000])//Timing

vals=nsoln[[2,All,2]]

vals500=;

vals1000=;

N[vals500-vals1000]

Why do computations to 500 and 1000 digits of precision differ by (10^(-124)) when each should be good to ≥ 500 digits?

(rvals=RootApproximant/@N[vals,100])//Timing

(rvals=RootApproximant/@N[vals,120])//Timing

(rvals=RootApproximant/@vals)//Timing

vals-rvals

(val=RootApproximant[nsoln[[1]]])//Timing

N[val,20]

val1000=;
val500=;

N[val1000-val500,20]

Exact [crashes]

(soln=Maximize[{f,cons},{x1,x2,x3,x4,x5,y1,y2,y3,y4,y5}])//Timing

bug(451961): Maximize[{f, cons}, {x1, x2, x3, x4, x5, y1, y2, y3, y4, y5}] crashes kernel

Numeric

mypts={0.26213803420474135`,0.6712296995650712`,0.6712283869533839`,0.9090917347815801`,0.9090903334571598`,0.9650304262809407`,0.7412494883383148`,0.741250676956143`,0.4165960896053604`,0.4165991475472878`};

myv={{0,0},{x1-x2,y1-y2},{x3-x1-x5,y1-y3+y5},{-x1,y1},{0,1},{x1,y1},{x1-x2+x4,y1-y2+y4},{x3-x1,y1-y3}}/.Thread[vars->mypts];

Show[Graphics[{
{Red,Thickness[.01],ClosedLine[{#1,-#2}&@@@myv]},
{Blue,ClosedLine[BLP[8]]}
}],AspectRatio->Automatic]

Audet

audetpts=Flatten[{#,Sqrt[1-#^2]}&[{.26214,.67194,.67194,.90980,.90980}]];

{f/.Thread[vars->mypts],f/.Thread[vars->audetpts]}

Embeddings

<<MathWorld`Graphs`

{"BiggestLittlePolygon", 6}

Names

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

GraphData[{"BiggestLittlePolygon",6},"StandardNames"]

Primary

GraphData[{"BiggestLittlePolygon",6}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"BiggestLittlePolygon",6},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"BiggestLittlePolygon",6}]]

Default embedding

GraphPlot[RotateGraph[Graph[GraphData[{"BiggestLittlePolygon",6},"VertexList"],GraphData[{"BiggestLittlePolygon",6},"Edges"]],-Pi/2]]

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

RecognizeGraph@g

gs=UnlabelGraph/@{,}

Degenerate

GraphData[{"BiggestLittlePolygon",6},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"BiggestLittlePolygon",6},"Graph","Degenerate"]

Configuration

GraphData[{"BiggestLittlePolygon",6},"Configuration"]

GraphData[{"BiggestLittlePolygon",6},"Graph","Configuration"]//StyleGraphs

Perspective

GraphData[{"BiggestLittlePolygon",6},"Graph","Perspective"]//StyleGraphs

HoneycombToroidal construction

GraphData[{"BiggestLittlePolygon",6},"NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData[{"BiggestLittlePolygon",6},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"BiggestLittlePolygon",6},"Graph","IGraph"]//StyleGraphs

Bilateral

GraphData[{"BiggestLittlePolygon",6},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingQ[#],GraphSymmetryGroup[#]}&/@GraphData[{"BiggestLittlePolygon",6},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]

Circular

GraphData[{"BiggestLittlePolygon",6},"Graph","Circular"]//StyleGraphs

Circular construction

GraphData[{"BiggestLittlePolygon",6},"Hamiltonian"]

GraphData[{"BiggestLittlePolygon",6},"HamiltonianCycleCount"]

Length[hc=FindHamiltonianCycle[GraphData[{"BiggestLittlePolygon",6}],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData[{"BiggestLittlePolygon",6}],#]&/@hc

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

gs=bilat

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

quad

Planar

GraphData[{"BiggestLittlePolygon",6},"Planar"]

GraphData[{"BiggestLittlePolygon",6},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"BiggestLittlePolygon",6},{"RCN","CN"}]

GraphData[{"BiggestLittlePolygon",6},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

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

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

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",6}],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",6}],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",6}],TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",6}],TimeConstraint->86400])//AbsoluteTiming

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",6},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

Select[gs,Max[OuterFace[#]]<=GraphData[{"BiggestLittlePolygon",6},"V"]&]

GraphPlot@RotateGraph[,π+Pi/4]

v=Join[{{-1,0},{1,0},{0,Sqrt[3]}},{#,#2+1/4}&@@@{{-1/4,1/4},{1/4,1/4},{0,3/4}}];
g=Graph[Range@Length@v,UndirectedEdge@@@{e[1,5,4,2,3,1,6,2,5,6,4,1],{3,6}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

GraphPlot@RotateGraph[,2Pi/3]

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

RecognizeGraph@g

gs=UnlabelGraph/@{,}

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",6},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

(gs=Table[MinimalCrossingGraph[GraphData[{"BiggestLittlePolygon",6}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union)//Timing

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",6},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

RectilinearLocalCrossingCount[g]

MinimalLocalCrossing

GraphData[{"BiggestLittlePolygon",6},"LocalCrossingNumber"]

GraphData[{"BiggestLittlePolygon",6},"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[{"BiggestLittlePolygon",6}],TimeConstraint->10])//AbsoluteTiming

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",6},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",6},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

Circulant

GraphData[{"BiggestLittlePolygon",6},"Circulant"]

GraphData[{"BiggestLittlePolygon",6},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"BiggestLittlePolygon",6},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"BiggestLittlePolygon",6}]])//Timing

CirculantGraph1@@@ci

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

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"BiggestLittlePolygon",6},"ComplementGraph","Name"]

GraphData[compl,"Graph","All"]

gs=GraphComplement/@%

Select[%,!DegenerateGraphEmbeddingQ[#]&]

Line graph

GraphData[{"BiggestLittlePolygon",6},"Line"]

LineGraphQ[GraphData[{"BiggestLittlePolygon",6}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"BiggestLittlePolygon",6}&]

RootGraph[GraphData[{"BiggestLittlePolygon",6}]]

RecognizeGraph[%]

Halin

GraphData[{"BiggestLittlePolygon",6},"Halin"]

GraphData[{"BiggestLittlePolygon",6},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"BiggestLittlePolygon",6},"Rigid"]

GraphData[{"BiggestLittlePolygon",6},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"BiggestLittlePolygon",6},"Flexible"]

GraphData[{"BiggestLittlePolygon",6},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"BiggestLittlePolygon",6},"LCF"]

GraphData[{"BiggestLittlePolygon",6},"HamiltonianCycleCount"]

GraphData[{"BiggestLittlePolygon",6},"LCFSignature"]

GraphData[{"BiggestLittlePolygon",6},"LCFNotations"]

GraphData[{"BiggestLittlePolygon",6},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"BiggestLittlePolygon",6},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"BiggestLittlePolygon",6}],Debug->True]//Timing

GraphData[{"BiggestLittlePolygon",6},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"BiggestLittlePolygon",6},"VertexList"],GraphData[{"BiggestLittlePolygon",6},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData[{"BiggestLittlePolygon",6},"Matchstick"]

GraphData[{"BiggestLittlePolygon",6},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"BiggestLittlePolygon",6},"Edges"]]

3D All

GraphData[{"BiggestLittlePolygon",6},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"BiggestLittlePolygon",6},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"BiggestLittlePolygon",6},"Polyhedral"]

GraphData[{"BiggestLittlePolygon",6},"Graph",{"3D","Polyhedron"}]

{"BiggestLittlePolygon", 8}

Names

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

GraphData[{"BiggestLittlePolygon",8},"StandardNames"]

Primary

GraphData[{"BiggestLittlePolygon",8}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"BiggestLittlePolygon",8},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"BiggestLittlePolygon",8}]]

Default embedding

GraphPlot@RotateGraph[Graph[Graph[GraphData[{"BiggestLittlePolygon",8},"VertexList"],GraphData[{"BiggestLittlePolygon",8},"Edges"]]],Pi/2]

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

RecognizeGraph@g

y=Mean[v[[{4,5}]]][[2]]//FullSimplify

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

RecognizeGraph@g

gs=UnlabelGraph/@{,}

Degenerate

GraphData[{"BiggestLittlePolygon",8},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"BiggestLittlePolygon",8},"Graph","Degenerate"]

Configuration

GraphData[{"BiggestLittlePolygon",8},"Configuration"]

GraphData[{"BiggestLittlePolygon",8},"Graph","Configuration"]//StyleGraphs

Perspective

GraphData[{"BiggestLittlePolygon",8},"Graph","Perspective"]//StyleGraphs

HoneycombToroidal construction

GraphData[{"BiggestLittlePolygon",8},"NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData[{"BiggestLittlePolygon",8},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"BiggestLittlePolygon",8},"Graph","IGraph"]//StyleGraphs

Bilateral

GraphData[{"BiggestLittlePolygon",8},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingQ[#],GraphSymmetryGroup[#]}&/@GraphData[{"BiggestLittlePolygon",8},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]

Circular

GraphData[{"BiggestLittlePolygon",8},"Graph","Circular"]//StyleGraphs

Circular construction

GraphData[{"BiggestLittlePolygon",8},"Hamiltonian"]

GraphData[{"BiggestLittlePolygon",8},"HamiltonianCycleCount"]

Length[hc=FindHamiltonianCycle[GraphData[{"BiggestLittlePolygon",8}],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData[{"BiggestLittlePolygon",8}],#]&/@hc

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

gs=bilat

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

quad

Planar

GraphData[{"BiggestLittlePolygon",8},"Planar"]

GraphData[{"BiggestLittlePolygon",8},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"BiggestLittlePolygon",8},{"RCN","CN"}]

GraphData[{"BiggestLittlePolygon",8},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

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

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

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",8}],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",8}],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",8}],TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"BiggestLittlePolygon",8}],TimeConstraint->86400])//AbsoluteTiming

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",8},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

Select[gs,Max[OuterFace[#]]<=GraphData[{"BiggestLittlePolygon",8},"V"]&]

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",8},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

(gs=Table[MinimalCrossingGraph[GraphData[{"BiggestLittlePolygon",8}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union)//Timing

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",8},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

GraphPlot@RotateGraph[,-4Pi/5]

y=Mean[v[[{4,5}]]][[2]]//FullSimplify

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

RectilinearLocalCrossingCount[g]

MinimalLocalCrossing

GraphData[{"BiggestLittlePolygon",8},"LocalCrossingNumber"]

GraphData[{"BiggestLittlePolygon",8},"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[{"BiggestLittlePolygon",8}],TimeConstraint->10])//AbsoluteTiming

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",8},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

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

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData[{"BiggestLittlePolygon",8},"V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

Circulant

GraphData[{"BiggestLittlePolygon",8},"Circulant"]

GraphData[{"BiggestLittlePolygon",8},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"BiggestLittlePolygon",8},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"BiggestLittlePolygon",8}]])//Timing

CirculantGraph1@@@ci

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

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"BiggestLittlePolygon",8},"ComplementGraph","Name"]

Line graph

GraphData[{"BiggestLittlePolygon",8},"Line"]

LineGraphQ[GraphData[{"BiggestLittlePolygon",8}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"BiggestLittlePolygon",8}&]

RootGraph[GraphData[{"BiggestLittlePolygon",8}]]

RecognizeGraph[%]

Halin

GraphData[{"BiggestLittlePolygon",8},"Halin"]

GraphData[{"BiggestLittlePolygon",8},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"BiggestLittlePolygon",8},"Rigid"]

GraphData[{"BiggestLittlePolygon",8},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"BiggestLittlePolygon",8},"Flexible"]

GraphData[{"BiggestLittlePolygon",8},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"BiggestLittlePolygon",8},"LCF"]

GraphData[{"BiggestLittlePolygon",8},"HamiltonianCycleCount"]

GraphData[{"BiggestLittlePolygon",8},"LCFSignature"]

GraphData[{"BiggestLittlePolygon",8},"LCFNotations"]

GraphData[{"BiggestLittlePolygon",8},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"BiggestLittlePolygon",8},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"BiggestLittlePolygon",8}],Debug->True]//Timing

GraphData[{"BiggestLittlePolygon",8},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"BiggestLittlePolygon",8},"VertexList"],GraphData[{"BiggestLittlePolygon",8},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData[{"BiggestLittlePolygon",8},"Matchstick"]

GraphData[{"BiggestLittlePolygon",8},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"BiggestLittlePolygon",8},"Edges"]]

3D All

GraphData[{"BiggestLittlePolygon",8},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"BiggestLittlePolygon",8},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"BiggestLittlePolygon",8},"Polyhedral"]

GraphData[{"BiggestLittlePolygon",8},"Graph",{"3D","Polyhedron"}]