Configuration

Author

Eric W. Weisstein
September 24, 2024

This notebook downloaded from https://mathworld.wolfram.com/notebooks/Configurations/Configuration.nb.

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

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

How to treat "spanning edges"?

As implemented, the {"Configuration", ...} graphs are not unique for a given incidence because they use edges = line segments instead of allowing edges between all pairs of points on a line.
Not sure how I should handle that.
I could make the underlying graphs include all edges, but since those display the same as if the "spanning" edges are not there, their visual appearance is misleading.

AddAllConfigurationEdges[g_Graph,opts___?OptionQ]:=Module[{pts=GraphEmbedding[g],lines,e},
lines=ResourceFunction["FindExtraordinaryLines"][pts];
e=Sort[Sort/@Flatten[Subsets[#,{2}]&/@lines,1]];
Graph[Range@Length@pts,UndirectedEdge@@@e,VertexCoordinates->pts,opts]
]

Graph[{1,2,3},UndirectedEdge@@@{{1,2},{2,3},{1,3}},VertexCoordinates->{{0,0},{1,0},{2,0}},VertexLabels->Automatic,EdgeShapeFunction->"CurvedEdge"]

Unfortunately, if I make the graphs contain all edges, then different configurations can give the same graph:

todo=SortBy[Select[GraphData[All],AnyTrue[Cases[GraphData[#,"StandardNames"],_String,∞],StringContainsQ["Configuration"]]&],GraphData[#,"V"]&]

TextGrid[{#,AddAllConfigurationEdges[GraphData[#,"Graph","Configuration"][[1]]]//RecognizeGraph}&/@Drop[todo,-10],Dividers->All]

g1=AddAllConfigurationEdges[GraphData[{"Configuration",{{10,3},2}}]]

g2=AddAllConfigurationEdges[GraphData[{"Configuration",{{10,3},3}}]]

RecognizeGraph/@{g1,g2}

First ((Subscript[(Subscript[10, 3])), 10]) "configuration graph"

g10a=;

e10a=EdgeList[g10a]

points=GraphEmbedding[g10a]

lines=ResourceFunction["FindExtraordinaryLines"][points]

LeviGraph[lines]//RecognizeGraph

mg10a=AddAllConfigurationEdges[g10a,VertexLabels->Automatic]

me10a=EdgeList[mg10a]

Complement[me10a,e10a]

Annotate[mg10a,EdgeShapeFunction->Table[e->"CurvedEdge",{e,Complement[me10a,e10a]}]]

DegenerateGraphEmbeddingTypes[mg10a]

Second ((Subscript[(Subscript[10, 3])), 10]) "configuration graph"

g10b=;

e10b=EdgeList[g10b]

points=GraphEmbedding[g10b]

lines=ResourceFunction["FindExtraordinaryLines"][points]

LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[{"CubicTransitive",25},"StandardNames"],{"Incidence",_}]

mg10b=AddAllConfigurationEdges[g10b,VertexLabels->Automatic]

DegenerateGraphEmbeddingTypes[mg10b]

me10b=EdgeList[mg10b]

Complement[me10b,e10b]

Annotate[mg10b,EdgeShapeFunction->Table[e->"CurvedEdge",{e,Complement[me10b,e10b]}]]

Isomorphism

g's are not the same:

IsomorphicGraphQ[g10a,g10b]

But mg's are:

IsomorphicGraphQ[mg10a,mg10b]

Configurations

https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

Boben, M.; Grünbaum, B.; Pisanski, T.; and Zitnik.  "Small Triangle-Free Configurations of Points and Lines."  Disc. Comput. Geom. 35, 405–427, 2006.

(A triangle in a configuration is a triplet of points, not on one line of the configuration, such that each pair does lie on a line of the configuration.)

3 [0 (Subscript[3, 3])'s]

GraphData["TriangleGraph","IncidenceLines"]

Select[GraphData[All],(!FreeQ[GraphData[#,"StandardNames"],{"Incidence",{{3,_},__}}])&]

TextGrid[{levi=RecognizeGraph[LeviGraph[#]],FirstCase[GraphData[levi,"StandardNames"],{"Incidence",i_}:>i]}&/@configurations10,Dividers->All]

((Subscript[3, 1])) == triangle; Levi graph == {"Cycle", 6}

points={{-1,0},{1,0},{0,Sqrt[3]}};
lines=Subsets[Range[3],{2}]

Graphics[{PointSize[.02],Point[points],MapIndexed[Text[#2[[1]],#,2{-2,-1}]&,points],Line[points[[#]]]&/@lines}]

LeviGraph[lines]//RecognizeGraph

GraphData[{"Cycle",6},"IncidenceLines"]

GraphData[{"Cycle",6},"IncidenceLines"]

RecognizeGraph/@LeviGraph/@%

6 [0 (Subscript[6, 3])'s]

Select[GraphData[All],(!FreeQ[GraphData[#,"StandardNames"],{"Incidence",{{6,_},__}}])&]

(Subscript[6, 4 ]) == Miquel circle configuration (Levi graph "RhombicDodecahedralGraph")

Graphics[{PointSize[.03],Circle[{0,0},Sqrt[(1/2)^2+(1/4)^2]],Circle[{1,0},Sqrt[(1/2)^2+(1/4)^2]],Circle[{0,1},Sqrt[(1/2)^2+(1/4)^2]],Circle[{1,1},Sqrt[(1/2)^2+(1/4)^2]],Circle[{1/2,1/2},1/4],Circle[{1/2,1/2},3/4],MapIndexed[{{Red,Point[#]},Text[#2[[1]],.07{1,1}+#1,Background->White]}&,{{(1/2),-(1/4)},{(1/2),(1/4)},{(1/2),(3/4)},{(1/2),(5/4)},{-(1/4),(1/2)},{(1/4),(1/2)},{(3/4),(1/2)},{(5/4),(1/2)}}]},ImageSize->250,BaseStyle->{FontSize->12}]

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

GraphData["RhombicDodecahedralGraph","IncidenceLines"]

RecognizeGraph/@LeviGraph/@%

7 [1 (Subscript[7, 3])'s]

Select[GraphData[All],(!FreeQ[GraphData[#,"StandardNames"],{"Incidence",{{7,_},__}}])&]

((Subscript[7, 3])) == Fano plane -> "HeawoodGraph" Levi graph

GraphData["HeawoodGraph","StandardNames"]

p1={{-1,0},{1,0},{0,Sqrt[3]}};
points=Join[p1,Mean/@Partition[p1,2,1,1],{Mean[p1]}];
lines={{1,7,5},{2,7,6},{3,7,4},{1,6,3},{3,5,2},{1,4,2}};
circ={4,5,6};

Graphics[{PointSize[.02],Point[points],MapIndexed[Text[#2[[1]],#,2{-2,-1}]&,points],Circumsphere[points[[circ]]],Line[points[[#]]]&/@lines}]

RecognizeGraph@LeviGraph[Append[lines,circ]]

GraphData["HeawoodGraph","IncidenceLines"]

RecognizeGraph/@LeviGraph/@%

GraphData["FanoPlaneGraph","AllImages"][[1]]

ChangeVertices[Graph["FanoPlaneGraph"],Last[GraphData["FanoPlaneGraph","Embeddings"]]]//ShowLabeledGraph

l=Sort[Sort/@{{1,4,7},{2,4,6},{3,4,5},{7,3,6},{5,1,6},{7,2,5},{1,2,3}}]

g=LeviGraph[l];

RecognizeGraph[g]

(g=ChangeVertices[Graph[#],GraphData[#,"Embeddings"][[2]]]&["FanoPlaneGraph"])//ShowLabeledGraph

Show[GraphPlot[DeleteEdges[g,Partition[Range[3],2,1,1]],Method->None],Graphics[Circle[Vertices[g][[4]],Norm[Subtract@@Vertices[g][[{1,4}]]]]]]

8 [1 (Subscript[8, 3])'s]

Select[GraphData[All],(!FreeQ[GraphData[#,"StandardNames"],{"Incidence",{{8,_},__}}])&]

((Subscript[8, 3])) == Moebius configuration -> "MoebiusKantorGraph" Levi graph

Mean[{{-1/2,0},{0,Sqrt[3]/2}}]

RegionIntersection[Line[{{-1/2,0},{1/4,(Sqrt[3])/4}}],Line[{{0,0},{-1/4,(Sqrt[3])/4}}]]//FullSimplify

points={{-1/2,0},{0,0},{1/2,0},{0,Sqrt[3]/2},{-(1/4),((Sqrt[3])/4)},{(1/4),((Sqrt[3])/4)},{(1/8),((Sqrt[3])/8)},{-(1/8),((Sqrt[3])/8)}};

lines={{1,2,3},{3,6,4},{4,5,1},{2,7,6},{2,8,5},{3,7,5},{1,8,6}};
circles={{4,7,8}};

Graphics[{Line[points[[#]]]&/@lines,Circumsphere[points[[#]]]&/@circles,{Red,PointSize[.02],Point[points]},MapIndexed[Text[#2[[1]],#,1.5{-1,-1},Background->White]&,points]}]

incidences=Join[lines,circles]

LeviGraph[incidences]//RecognizeGraph

GraphData["MoebiusKantorGraph","IncidenceLines"]

RecognizeGraph/@LeviGraph/@%

9 [3 (Subscript[9, 3])'s]

https://web.archive.org/web/20050321114110/http://www.ijp.si/Configurations2004/lectures/Changes.ppt

Branko Grünbaum
Lecture Notes on Configurations
—
prepared for the workshop 
Configurations 2004
September 1 – 4, 2004
Bled, Slovenia
—
to be presented by 
Tomaž Pisanski and Marko Bobe

configurations9={
{{1,2,3},{1,4,5},{1,6,7},{2,4,6},{2,5,8},{3,4,9},{3,7,8},{5,7,9},{6,8,9}},
{{1,2,3},{1,4,5},{1,6,7},{2,4,6},{2,5,8},{3,5,9},{3,7,8},{4,7,9},{6,8,9}},
{{1,2,7},{3,4,7},{5,6,7},{1,6,8},{2,3,8},{4,5,8},{1,4,9},{3,6,9},{2,5,9}}
};

RecognizeGraph/@LeviGraph/@c9

Select[GraphData[All],(!FreeQ[GraphData[#,"StandardNames"],{"Incidence",{{9,_},__}}])&]

TextGrid[{levi=RecognizeGraph[LeviGraph[#]],Cases[GraphData[levi,"StandardNames"],{"Incidence",i_}:>i]}&/@configurations9,Dividers->All]

(Subscript[9, 3]) #1 == {"Configuration", {{9, 3}, 1}} (Levi graph {"Incidence", {{9, 3}, 1}})

pts={{0,0},{(1/2),((Sqrt[3])/2)},{(1/2),(1/2) (-2 (Sqrt[3])+(Sqrt[15]))},{1,0},{(1/4) (3-(Sqrt[5])),(1/4) (3 (Sqrt[3])-(Sqrt[15]))},{(3/4) (3-(Sqrt[5])),(1/4) (3 (Sqrt[3])-(Sqrt[15]))},{(1/4) (5-(Sqrt[5])),(1/4) (-(Sqrt[3])+(Sqrt[15]))},{(1/2) (-1+(Sqrt[5])),0},{(1/4) (-5+3 (Sqrt[5])),(1/4) (3 (Sqrt[3])-(Sqrt[15]))}};
lines={{1,2,5},{1,4,8},{1,7,9},{2,6,8},{2,4,7},{3,4,5},{3,6,7},{3,8,9},{5,6,9}};

ConfigurationDiagram[pts,lines,.15]//Quiet

cg=ConfigurationGraph[pts,lines,VertexLabels->Automatic]//Quiet

ConfigurationLinesFromGraph[cg]//Quiet

cgname=RecognizeGraph[cg]

GraphData[cgname,"Graph","Configuration"]

(Subscript[9, 3]) #2 == {"Configuration", {{9, 3}, 2}} (Levi graph {"CubicTransitive", 20})

pts={{0,0},{(1/4),((Sqrt[3])/4)},{(1/2),0},{(1/2),((Sqrt[3])/2)},{(3/4),((Sqrt[3])/4)},{1,0},{((Sqrt[5])/4),((Sqrt[3])/4)},{(1/8) (5-(Sqrt[5])),(1/8) (-(Sqrt[3])+(Sqrt[15]))},{(1/8) (7-(Sqrt[5])),(1/8) (3 (Sqrt[3])-(Sqrt[15]))}};
lines={{1,3,6},{3,9,5},{6,8,9},{1,8,7},{4,7,9},{2,7,5},{1,2,4},{2,8,3},{4,5,6}};

ConfigurationDiagram[pts,lines,.15]

cg=ConfigurationGraph[pts,lines,VertexLabels->Automatic]

cgname=RecognizeGraph[cg]

RecognizeGraph@LeviGraph[lines]

GraphData[cgname,"Graph","Configuration"]

(Subscript[9, 3]) #3 == Pappus configuration (Levi graph "PappusGraph")

pts={{0,0},{2,0},{1,0},{0,1},{2,(5/4)},{(32/41),(45/41)},{(32/77),(45/77)},{(8/9),(5/9)},{(61/43),(45/86)}};
lines={{1,3,2},{1,7,6},{1,8,5},{2,8,4},{2,9,6},{3,7,4},{3,9,5},{4,6,5},{7,8,9}};

ConfigurationDiagram[pts,lines,.3]

cg=ConfigurationGraph[pts,lines,VertexLabels->Automatic]

cgname=RecognizeGraph[cg]

GraphData["PappusConfigurationGraph","Graph","Configuration"]

((Subscript[9, 4]) (Subscript[12, 3])) == Hesse configuration of nine inflection points of a cubic curve in the complex projective plane and the twelve lines determined by pairs of these points

10

From pages 6 and 7, https://web.archive.org/web/20050321114110/http://www.ijp.si/Configurations2004/lectures/Changes.ppt

Branko Grünbaum
Lecture Notes on Configurations
—
prepared for the workshop 
Configurations 2004
September 1 – 4, 2004
Bled, Slovenia
—
to be presented by 
Tomaž Pisanski and Marko Bobe

Kantor, Die Configurationen (3,3)_10 Wien. Ber LXXXIV(1881), 1291-1314.

Configuration 4 requires pseudolines,

Incorrect 2 noted by Ed Pegg, Jr. on Dec 19, 2023

configurations10 =1+{
{{0,4,6},{0,5,7},{0,8,9},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,6,9},{3,5,8},{3,7,9}},{{0,4,6},{0,5,7},{0,8,9},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,6,9},{3,5,9},{3,7,8}},{{0,4,6},{0,5,7},{0,8,9},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,7,9},{3,5,9},{3,6,8}},{{0,8(*2*),9},{0,4,6},{0,5,7},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,5,9},{3,6,8},{3,7,9}},{{0,3,6},{0,5,7},{0,8,9},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,5,9},{3,7,8},{4,6,9}},{{0,3,5},{0,4,6},{0,9,8},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,6,9},{3,7,8},{5,7,9}},{{0,3,7},{0,4,8},{0,6,9},{1,2,3},{1,4,5},{1,6,7},{2,4,6},{2,8,9},{3,5,9},{5,7,8}},{{0,3,4},{0,5,8},{0,7,9},{1,2,3},{1,4,5},{1,6,7},{2,4,6},{2,7,8},{3,8,9},{5,6,9}},{{0,2,7},{0,4,8},{0,6,9},{1,2,3},{1,4,5},{1,6,7},{2,8,9},{3,4,6},{3,5,9},{5,7,8}},{{0,2,8},{0,3,4},{0,7,9},{1,2,3},{1,4,5},{1,6,7},{2,4,6},{3,8,9},{5,6,9},{5,7,8}}};

Length[configurations10]

Union[Sort[Tally[Flatten[#]]]&/@configurations10]

Prior to 14.1 (wrong):

LeviGraph[{{0,2,9},{0,4,6},{0,5,7},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,5,9},{3,6,8},{3,7,9}}]//RecognizeGraph

V14.1 and later (correct):

LeviGraph[configurations10[[4]]]//RecognizeGraph

Branko Grunbaum, Configurations of Points and Lines, Amer. Math Soc., p. 74, 2009.

Ed's constructions follow those in Grunbaum 77-79, which skips the #4 configuration.  His constructions in turn follow from
a Schroter 1889 paper.

Select[GraphData[All],(!FreeQ[GraphData[#,"StandardNames"],{"Incidence",{{10,_},__}}])&]

TextGrid[{levi=RecognizeGraph[LeviGraph[#]],Cases[GraphData[levi,"StandardNames"],{"Incidence",i_}:>i]}&/@configurations10,Dividers->All]

From Ed Pegg, Jr.
Dec 18, 2023

points={
(*1*){{0,0},{0,1},{0,3},{2,1},{2,2},{2,4},{3,3},{4,2},{4,3},{8,1}},
(*2*){{9,-5},{5,-10},{-5,8},{3,8},{-5,-5},{(40/9),-5},{(97/5),8},{-(26085/1801),-(18105/1801)},{(5384/375),-(7481/750)},{-5,-(25/96)}},
(*3*){{0,0},{8,-12},{0,4},{14,-7},{6,7},{0,-(56/3)},{-(28/5),(42/5)},{(1428/523),-(3654/523)},{-(289/50),(111/100)},{-(1764/295),-(2058/295)}},
(*4 -- not geometric*){{0,2},{2 (Sqrt[2]),2},{2,2},{0,-(1/(Sqrt[2]))},{0,0},{4,-2},{2,0},{(1/73) (208-30 (Sqrt[2])),(1/73) (22+60 (Sqrt[2]))},{(1/267) (392+94 (Sqrt[2])),((13568+15630 (Sqrt[2]))/25899)},{(1/7) (-4-8 (Sqrt[2])),0}},
(*5*){{5,4},{-5,13},{5,0},{0,0},{-5,0},{-5,-4},{-(1735/1707),-(6760/1707)},{(9315/1231),(2080/1231)},{5,-(39/10)},{(65/21),-(169/21)}},
(*6*){{0,0},{-10,9},{7,0},{7,9},{-10,-6},{7,-(63/10)},{-10,0},{-(770/757),-(4662/757)},{220/403,1332/403},{1385/74,9}},
(*7*){{-4,8},{3,13},{3,-9},{13,17},{-4,-5},{3,(69/17)},{-(334/17),(67/17)},{(65846139/6988873),(3098301/6988873)},{(3878949/660505),-(10552599/660505)},{-(783457/70461),(205393/70461)}},
(*8*){{11,0},{-4,-6},{-13,0},{-13,12},{-1,0},{-13,-(48/5)},{-(67/10),(78/5)},{-(41/5),(48/5)},{-(37/7),(30/7)},{(169/59),-(624/59)}},
(*9*){{16,0},{0,0},{0,12},{10,16},{0,-12},{-(240/17),-(384/17)},{-(24150/2893),(11808/2893)},{-(6306/431),0},{-(5520/967),(15744/967)},{-(24150/2341),(18432/2341)}},
(*10*){{-1-(Sqrt[2]),-1-(Sqrt[2])},{-1,-1-(Sqrt[2])},{-1,-1+(Sqrt[2])},{-1,1+(Sqrt[2])},{0,-1},{0,1},{1,-1-(Sqrt[2])},{1,1-(Sqrt[2])},{1,1+(Sqrt[2])},{1+(Sqrt[2]),1+(Sqrt[2])}}};

lines=lines=ResourceFunction["FindExtraordinaryLines"][#]&/@points

Length/@points

Length[ResourceFunction["FindExtraordinaryLines"][#]]&/@points

TextGrid[
data=MapIndexed[
{
#2[[1]],
g=ConfigurationGraph@@#,
RecognizeGraph[g],
r=RecognizeGraph[LeviGraph[#[[2]]]],
FirstCase[GraphData[r,"StandardNames"],{"Incidence",_}]
}&,
Transpose[{points,lines}],
{1}
],
Dividers->All]

Ed's manipulate

disk=Graphics[{EdgeForm[{Black,Thick}],Green,Disk[{0,0},1]}, ImageSize-> {22,22}];

disks=Table[Graphics[{EdgeForm[{Black,Thick}],{Green,Cyan,Yellow}[[col]],Disk[{0,0},1], Style[Text[n/.{10-> 0},{0,0}],14,Black,Bold]}, ImageSize-> {22,22}],{n,1,13},{col,1,3}];

LineIntersectionPoint[{{a_,b_},{c_,d_}}]:=((Det[{a,b}] (c-d)-Det[{c,d}] (a-b))/(Det[{a-b,c-d}]));

constructions={
{{6,{{1,2},{3,4}}},{7,{{1,3},{2,4}}},{8,{{5,7}}},{9,{{1,5},{3,8}}},{10,{{4,8},{2,5}}}},
{{6,{{1,5},{2,4}}},{7,{{1,2},{3,4}}},{11,{{1,2},{4,5}}},{8,{{7,5},{3,11}}},{9,{{2,8},{1,3}}},{10,{{4,8},{3,5}}}},
{{6,{{1,3},{2,4}}},{7,{{1,2},{3,4}}},{11,{{1,4},{2,3}}},{12,{{7,11},{2,5}}},{8,{{4,12},{5,6}}},{9,{{2,8},{3,5}}},{10,{{4,8},{1,5}}}},
{{5,{{3,4}}},{6,{{2,5},{1,4}}},{11,{{1,3},{2,4}}},{12,{{3,6},{2,4}}},{13,{{2,3},{6,11}}},{7,{{1,12},{5,13}}},{8,{{1,2},{3,7}}},{9,{{1,3},{6,7}}},{10,{{2,4},{7,5}}}},
{{6,{{1,2},{3,4}}},{7,{{1,3},{2,5}}},{11,{{1,5},{2,3}}},{8,{{6,5},{4,11}}},{9,{{1,8},{4,5}}},{10,{{3,8},{2,4}}}},
{{6,{{2,3},{4,5}}},{7,{{2,4},{3,5}}},{11,{{1,6},{2,4}}},{12,{{1,3},{2,5}}},{13,{{3,5},{11,12}}},{8,{{1,6},{4,13}}},{9,{{1,3},{4,13}}},{10,{{8,7},{9,5}}}},
{{5,{{1,3}}},{6,{{1,2},{3,4}}},{11,{{1,4},{2,3}}},{12,{{2,3},{5,4}}},{13,{{1,4},{2,5}}},{14,{{2,4},{5,11}}},{7,{{6,14},{12,13}}},{8,{{1,4},{6,7}}},{9,{{2,7},{5,4}}},{10,{{2,3},{5,7}}}},
{{5,{{2,3}}},{6,{{1,5},{2,4}}},{11,{{1,2},{3,4}}},{12,{{1,3},{5,4}}},{13,{{1,4},{2,3}}},{7,{{6,13},{11,12}}},{8,{{1,2},{7,4}}},{9,{{1,3},{6,7}}},{10,{{5,7},{3,4}}}},
{{5,{{1,3}}},{6,{{1,2},{3,4}}},{11,{{1,4},{2,3}}},{12,{{2,3},{5,4}}},{13,{{2,4},{6,11}}},{7,{{1,12},{5,13}}},{8,{{1,4},{5,7}}},{9,{{2,7},{5,4}}},{10,{{6,7},{2,3}}}}
};

linesets={
{{1,5,9},{1,3,7},{4,8,10},{2,5,10},{3,4,6},{3,8,9},{2,4,7},{5,7,8},{1,2,6},{6,9,10}},
{{1,5,6},{2,4,6},{3,4,7},{5,7,8},{1,3,9},{2,8,9},{3,5,10},{4,8,10},{6,9,10},{1,2,7,11},{3,8,11},{4,5,11}},
{{1,3,6},{2,4,6},{1,2,7},{3,4,7},{5,6,8},{2,8,9},{3,5,9},{1,5,10},{7,9,10},{4,8,10,12},{1,4,11},{2,3,11},{2,5,12},{7,11,12}},
{{3,4,5},{1,4,6},{2,5,6},{1,2,8},{3,7,8,11,12},{1,3,9},{6,7,9},{2,4,10},{5,7,10},{8,9,10,13},{1,3,11},{2,4,11},{1,7,12},{2,4,12},{3,6,12},{2,3,13},{5,7,13},{6,11,13}},
{{1,2,6},{3,4,6},{1,3,7},{2,5,7},{5,6,8},{1,8,9},{4,5,9},{2,4,10},{3,8,10},{7,9,10},{1,5,11},{2,3,11},{4,8,11}},
{{2,3,6},{4,5,6},{2,4,7},{3,5,7},{1,6,8},{1,3,9},{4,8,9},{1,2,10},{5,9,10},{7,8,10},{1,6,11},{2,4,11},{1,3,12},{2,5,12},{3,5,13},{4,8,13},{4,9,13},{11,12,13}},
{{1,3,5},{1,2,6},{3,4,6},{1,4,8},{6,7,8},{2,7,9},{4,5,9},{2,3,10},{5,7,10},{8,9,10},{1,4,11},{2,3,11},{2,3,12},{4,5,12},{1,4,13},{2,5,13},{7,12,13},{2,4,14},{5,11,14},{6,7,14}},
{{2,3,5},{1,5,6},{2,4,6},{1,2,8},{4,7,8},{1,3,9},{6,7,9},{3,4,10},{5,7,10},{8,9,10},{1,2,11},{3,4,11},{1,3,12},{4,5,12},{7,11,12},{1,4,13},{2,3,13},{6,7,13}},
{{1,3,5},{1,2,6},{3,4,6},{1,4,8},{5,7,8},{2,7,9},{4,5,9},{2,3,10},{6,7,10},{8,9,10},{1,4,11},{2,3,11},{1,7,12},{2,3,12},{4,5,12},{2,4,13},{5,7,13},{6,11,13}}
};

nicestart={
{-1,{{0.866`,-0.032`},{-2.115`,1.134`},{1.9`,1.373`},{-0.843`,-0.147`},{-1.173`,-1.241`}}},
{0,{{0.882`,0.199`},{0.128`,-1.294`},{-0.828`,2.249`},{0.006`,1.784`},{-0.866`,-0.993`}}},
{0,{{-0.184`,0.268`},{0.394`,-1.622`},{0.075`,1.232`},{2.236`,-0.872`},{1.183`,1.476`}}},
{-0.695`,{{0.859`,1.399`},{-1.184`,1.872`},{1.046`,0.336`},{-0.495`,0.162`},{-1.566`,0.041`}}},
{0,{{-0.119`,-0.227`},{-0.941`,1.374`},{0.693`,-0.717`},{0.439`,1.335`},{-1.552`,-0.442`}}},
{0,{{-0.49`,0.754`},{0.346`,1.264`},{0.365`,-1.321`},{1.605`,1.658`},{-0.514`,-0.739`}}},
{0.572`,{{2.283`,-0.717`},{-0.029`,-1.177`},{-1.387`,-0.188`},{-1.091`,1.943`},{0.711`,-0.49`}}},
{1.581`,{{2.396`,-0.131`},{0.634`,-0.447`},{-0.205`,1.106`},{1.097`,1.572`},{1.122`,-1.351`}}},
{1.998`,{{-0.484`,-0.409`},{-0.041`,-1.33`},{-1.008`,-2.157`},{-1.325`,0.175`},{0.038`,1.337`}}}
};

NinePointCubic[pts3_]:= Module[{makeRow2, cubic2,poly2, coeff2, nonzero, candidate},
If[Min[Total[Abs[RowReduce[#][[3]]]]&/@Subsets[Append[#,1]&/@pts3,{4}]]>0,
makeRow2[{x_,y_}]:={1,x,x^2,x^3,y,y x, y x^2, y^2, y^2 x, y^3};
cubic2[x_,y_][p_]:=Det[makeRow2/@Join[{{x,y}},p]];
poly2=cubic2[x,y][pts3];
coeff2 = Flatten[CoefficientList[poly2,{y,x}]];
nonzero = First[Select[coeff2,Abs[#]>0&]];
candidate= Expand[Simplify[ poly2/nonzero]];
If[Length[FactorList[candidate]]>2,"degenerate",candidate],
"degenerate"]];
Manipulate[
Module[{construction, pts,offset,lines},
If[pick≠ oldpick, oldpick=pick;  s1=nicestart[[pick,1]]; {p1,p2,p3,p4,p5}=nicestart[[pick,2]]; 
slideval={8,0,0,5,0,0,5,5,5}[[pick]]; movable={5,5,5,4,5,5,4,4,4}[[pick]]];
construction=constructions[[pick]];
pts={p1,p2,p3,p4,p5,p6,p7,p8,p9,p0,p11,p12,p13,p14};
Do[
pts[[construction[[index,1]]]]=If[Length[construction[[index,2]]]==1,
(s1)pts[[construction[[index,2,1,1]]]]+(1-s1)pts[[construction[[index,2,1,2]]]],
LineIntersectionPoint[Partition[pts[[Flatten[construction[[index,2]]]]],2]]],
{index,1,Length[construction]}];

{p5,p6,p7,p8,p9,p0}= Take[pts,{5,10}];
lines=linesets[[pick]];
Graphics[{
EdgeForm[Black],
Tooltip[Line[Sort[pts[[#]]]],#]&/@Select[Take[#,3]&/@lines,Max[#]≤10&],
Table[Inset[disks[[n,If[n<=movable,1,If[slideval==n,2,3]]]],{p1,p2,p3,p4,p5,p6,p7,p8,p9,p0}[[n]]],{n,1,10}]},
 ImageSize-> {600,420}, PlotRange->{{-2.8,2.8},{-2.5,2.5}}]],
Row[{Control@{{pick,1,"3-configuration"},Range[9],ControlType-> Setter, ImageSize-> Tiny},Spacer[20],
Row[{"drag any ",disk}],
Spacer[20],
Control@{{s1,-1,Dynamic[If[slideval==0,Row[{Graphics[{},ImageSize-> {22,22}], "no shift"}],Row[{"shift ",disks[[slideval,2]]}]]]},-2,3,.01,Appearance->"Labeled", Enabled-> Dynamic@If[slideval==0,False,True], ImageSize-> Medium}}],
{{p1,{0.866`,-0.032`}},{-2.7,-2.4},{2.7,2.4},ControlType->Locator, Appearance-> None},
{{p2,{-2.115`,1.134`}},{-2.7,-2.4},{2.7,2.4},ControlType->Locator, Appearance-> None},
{{p3,{1.9`,1.373`}},{-2.7,-2.4},{2.7,2.4},ControlType->Locator, Appearance-> None},
{{p4,{-0.843`,-0.147`}},{-2.7,-2.4},{2.7,2.4},ControlType->Locator, Appearance-> None},
{{p5,{-1.173`,-1.241`}},{-2.7,-2.4},{2.7,2.4},ControlType->Locator, Appearance-> None},
{{p6,{0,0}},ControlType->None},{{p7,{0,0}},ControlType->None},
{{p8,{0,0}},ControlType->None},{{p9,{0,0}},ControlType->None},
{{p0,{0,0}},ControlType->None},{{p11,{0,0}},ControlType->None},
{{p12,{0,0}},ControlType->None},{{p13,{0,0}},ControlType->None},
{{p14,{0,0}},ControlType->None},{{oldpick,1}, ControlType-> None},
{{slideval,8}, ControlType-> None},{{movable,5}, ControlType-> None},
ControlPlacement-> Top, SaveDefinitions-> True,SynchronousInitialization->False]

{"Configuration", {{10, 3}, 1}} == "DesarguesConfigurationGraph"

pts={{0,0},{1,0},{2,(3/4)},{(1/2),(3/2)},{(671/816),(5/4)},{(7/5),(11/8)},{(68/97),(204/97)},{(331/136),0},{(799/234),(565/312)},{(113/37),(339/296)}};
lines={{1,2,8},{8,10,9},{9,6,5},{7,6,3},{7,4,1},{1,3,10},{9,3,2},{7,5,2},{8,5,4},{10,4,6}};

ConfigurationDiagram[pts,lines,.3]

cg=ConfigurationGraph[pts,lines,VertexLabels->Automatic]

cgname=RecognizeGraph[cg]

GraphData[cgname,"Graph","Configuration"]

RecognizeGraph@LeviGraph[lines]

GraphData["DesarguesGraph","IncidenceLines"]

RecognizeGraph/@LeviGraph/@%

{"Configuration", {{10, 3}, 4}} [nonrealizable]

From Ed Pegg, Jr.
Dec 18, 2023

Here’s a version of Kantor’s “close” configuration #4. The lines through point 9 don’t actually coincide.

con4={{0,2},{2 (Sqrt[2]),2},{2,2},{0,-(1/(Sqrt[2]))},{0,0},{4,-2},{2,0},{(1/73) (208-30 (Sqrt[2])),(1/73) (22+60 (Sqrt[2]))},{(1/267) (392+94 (Sqrt[2])),((13568+15630 (Sqrt[2]))/25899)},{(1/7) (-4-8 (Sqrt[2])),0}};
lin4=({{0,9,8},{0,4,6},{0,5,7},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,9,5},{3,6,8},{3,9,7}}/. 0->10);
Graphics[{Line[con4[[#]]]&/@lin4,Red, Point[con4],Blue, Table[Text[k,con4[[k]]+{-.1,.1}],{k,1,10}]}]

11

From pages 6 and 7, https://web.archive.org/web/20050321114110/http://www.ijp.si/Configurations2004/lectures/Changes.ppt

Branko Grünbaum
Lecture Notes on Configurations
—
prepared for the workshop 
Configurations 2004
September 1 – 4, 2004
Bled, Slovenia
—
to be presented by 
Tomaž Pisanski and Marko Bobe

configurations11=;

Length[configurations11]

Union[Sort[Tally[Flatten[#]]]&/@configurations11]

TextGrid[{levi=RecognizeGraph[LeviGraph[#]],Cases[GraphData[levi,"StandardNames"],{"Incidence",i_}:>i]}&/@configurations11,Dividers->All]

12

The first enumeration of the combinatorial configurations (123) was carried out by Daublebsky in 1895. Daublebsky presented the resulting 228 combinatorial configurations by their configurations tables (in the published paper, these tables take 23 pages !!!).  The first independent enumeration of the combinatorial  (123)  configurations was carried out only in 1990, by Gropp.  It showed that Daublebski missed one, so that there are in fact  229  such configurations. As with configurations (113), the 229 combinatorial configurations (123) have been independently enumerated (by two different methods) by Betten, Brinkmann and Pisanski in 2000.

configurations12=;

Length[configurations12]

Union[Sort[Tally[Flatten[#]]]&/@configurations12]

TextGrid[{levi=RecognizeGraph[LeviGraph[#]],Cases[GraphData[levi,"StandardNames"],{"Incidence",i_}:>i]}&/@configurations12,Dividers->All]

{{"Configuration", {{12, 3}, 210}} == "NauruConfigurationGraph"

GraphData["NauruConfigurationGraph","StandardNames"]

Danzer’s configuration revisited
Boben, Gevay, and Psanski
https://arxiv.org/pdf/1301.1067.pdf

lines=configurations12[[210]]

levi=RecognizeGraph@LeviGraph[lines]

GraphData[levi,"IncidenceLines"]

GraphData["NauruGraph","Incidence"]

RecognizeGraph/@LeviGraph/@GraphData["NauruGraph","IncidenceLines"]

((Subscript[12, 4]) (Subscript[16, 3])) == Reye configuration

((Subscript[12, 5]) (Subscript[30, 2])) == Schläfli double six, formed by 12 of the 27 lines on a cubic surface

15

(Subscript[15, 3]) == "CremonaRichmondConfigutationGraph" (Levi graph "Tutte8Cage")

Boben, M.; Grünbaum, B.; Pisanski, T.; and Zitnik.  "Small Triangle-Free Configurations of Points and Lines."  Disc. Comput. Geom. 35, 405–427, 2006.

https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

There is a unique triangle-free (Subscript[15, 3]) configuration, and it is "point "transitive

pts={{(1/2),(NumericalApproximation[Root, (RowDefault["-0.688", FEExpressionsNumericalApproximationElider]), Root[1-40 ((#1)^2)+80 ((#1)^4)&,1], ])},{(1/4) (1+(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["0.263", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,3], ])},{0,(NumericalApproximation[Root, (RowDefault["0.851", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,4], ])},{(1/4) (-1-(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["0.263", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,3], ])},{-(1/2),(NumericalApproximation[Root, (RowDefault["-0.688", FEExpressionsNumericalApproximationElider]), Root[1-40 ((#1)^2)+80 ((#1)^4)&,1], ])},{(1/2),(NumericalApproximation[Root, (RowDefault["2.39", FEExpressionsNumericalApproximationElider]), Root[361-520 ((#1)^2)+80 ((#1)^4)&,4], ])},{(1/2) (-2-(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["1.21", FEExpressionsNumericalApproximationElider]), Root[121-200 ((#1)^2)+80 ((#1)^4)&,4], ])},{(1/4) (-5-(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["-1.64", FEExpressionsNumericalApproximationElider]), Root[121-260 ((#1)^2)+80 ((#1)^4)&,1], ])},{1,(NumericalApproximation[Root, (RowDefault["-2.23", FEExpressionsNumericalApproximationElider]), Root[1-25 ((#1)^2)+5 ((#1)^4)&,1], ])},{(1/4) (3+3 (Sqrt[5])),(NumericalApproximation[Root, (RowDefault["0.263", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,3], ])},{(NumericalApproximation[Root, (RowDefault["2.27", FEExpressionsNumericalApproximationElider]), Root[-261+1338 #1-1120 ((#1)^2)-144 ((#1)^3)+176 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.0420", FEExpressionsNumericalApproximationElider]), Root[81-47340 ((#1)^2)+769760 ((#1)^4)-2579200 ((#1)^6)+774400 ((#1)^8)&,5], ])},{(NumericalApproximation[Root, (RowDefault["0.662", FEExpressionsNumericalApproximationElider]), Root[-9-258 #1+868 ((#1)^2)-808 ((#1)^3)+176 ((#1)^4)&,2], ]),(NumericalApproximation[Root, (RowDefault["2.17", FEExpressionsNumericalApproximationElider]), Root[9801-406980 ((#1)^2)+2964560 ((#1)^4)-4270400 ((#1)^6)+774400 ((#1)^8)&,8], ])},{(NumericalApproximation[Root, (RowDefault["-1.86", FEExpressionsNumericalApproximationElider]), Root[81+648 #1+1368 ((#1)^2)+888 ((#1)^3)+176 ((#1)^4)&,2], ]),(NumericalApproximation[Root, (RowDefault["1.30", FEExpressionsNumericalApproximationElider]), Root[531441-6065280 ((#1)^2)+10115360 ((#1)^4)-5278400 ((#1)^6)+774400 ((#1)^8)&,7], ])},{(NumericalApproximation[Root, (RowDefault["-1.81", FEExpressionsNumericalApproximationElider]), Root[99-258 #1-200 ((#1)^2)+304 ((#1)^3)+176 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["-1.37", FEExpressionsNumericalApproximationElider]), Root[9801-760140 ((#1)^2)+14344160 ((#1)^4)-8883200 ((#1)^6)+774400 ((#1)^8)&,2], ])},{(NumericalApproximation[Root, (RowDefault["0.742", FEExpressionsNumericalApproximationElider]), Root[9+60 #1-16 ((#1)^2)-240 ((#1)^3)+176 ((#1)^4)&,3], ]),(NumericalApproximation[Root, (RowDefault["-2.15", FEExpressionsNumericalApproximationElider]), Root[281961-37751760 ((#1)^2)+44161760 ((#1)^4)-11372800 ((#1)^6)+774400 ((#1)^8)&,2], ])}};
lines={{9,1,3},{15,11,10},{10,3,13},{11,12,6},{12,13,7},{6,4,14},{13,14,8},{7,5,15},{14,15,9},{8,1,11},{6,3,5},{7,4,1},{8,5,2},{10,2,4},{9,2,12}};

Length[lines]

ConfigurationDiagram[pts,lines,.2]

cg=ConfigurationGraph[pts,lines,VertexLabels->Automatic]

cgname=RecognizeGraph[cg]

GraphData[cgname,"Graph","Configuration"]

levi=RecognizeGraph@LeviGraph[pts,lines]

GraphData[levi,"IncidenceLines"]

RecognizeGraph/@LeviGraph/@%

16

((Subscript[16, 6])) == "KummerGraph" == Levi graph of Kummer configuration

https://en.wikipedia.org/wiki/Kummer_configuration

17

Unique triangle-free (Subscript[17, 3]) == {"Configuration", {{17, 3}, 1}} (Levi graph {"Incidence", {{17, 3}, 1}})

Marko Boben, Tomaz Pisanski, Arjana Zitnik, Branko Grunbaum
Small Triangle Free Configurations of Points and Lines
https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

pts={{1,0},{5/4,-433/1000},{1/2,433/500},{1/4,-1299/1000},{1/2,-433/500},{-15/47,433/1175},{-65/59,866/1475},{-5/4,433/1000},{-25/118,433/5900},{-1/4,1299/1000},{13/8,-433/500},{-13/8,433/500},{-1/2,433/500},{-25/118,1299/1180},{-5/4,433/300},{-1/2,-433/500},{-1,0}};
lines=Sort[Sort/@{{5,11,16},{6,14,16},{8,16,17},{5,9,15},{1,4,5},{2,10,11},{7,11,12},{3,14,15},{4,10,14},{6,9,13},{1,6,7},{7,15,17},{10,13,17},{2,8,9},{4,8,12},{1,2,3},{3,12,13}}]

ConfigurationDiagram[pts,lines]

cg=ConfigurationGraph[pts,lines,VertexLabels->Automatic]

cgname=RecognizeGraph[cg]

{"Configuration",{{17,3},1}}

GraphData[cgname,"Graph","Configuration"]

levi=RecognizeGraph@LeviGraph[lines]

{"Incidence",{{17,3},1}}

GraphData[levi,"IncidenceLines"]

RecognizeGraph/@LeviGraph/@%

{{"Incidence",{{17,3},1}}}

GraphData[{"Incidence",{{17,3},1}},"Graph","All"]

18

There are 4 triangle-free (Subscript[18, 3])'s

{"Configuration", {{18, 3}, 1}}

Marko Boben, Tomaz Pisanski, Arjana Zitnik, Branko Grunbaum
Small Triangle Free Configurations of Points and Lines
https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

xs=x/.{ToRules[Roots[148356340695120+340383889522429x+168711078656205x^2==0,x]]}

vx={{1,0},{((236458621907666150781840+48633027845686079003753x )/(114931140149531570038800+136064638041848583497585x)),((1973963333642016495120−1420146210813374013671x)/(22986228029906314007760+27212927608369716699517x))},{-761/655,-23/131},{3/5,-4/5},{((124010+124591x)/(37150−27020x)),((86860+151611x)/(8575−13510x))},{3/5,4/5},{-9/10,19/5},{-297/85,-31/17},{((2946000−6653199x)/(13520800+18088230x)),((6347680+10418226x )/(6760400+9044115x))},{-81/35,2/5},{((3-x)/(5+5x)),((4+5x)/(5+5x))},{-1/5,-1},{-9/10,-2/5},{-11/10,-1/10},{-1/5,1},{-8437/7130,-6148/3565},{17/10,2/5},{-9/10,2/5}};
v1=vx/.x->xs[[1]];
v2=vx/.x->xs[[2]];
lines={{1,2,3},{1,4,5},{1,6,7},{2,8,9},{2,10,11},{3,12,13},{3,14,15},{4,8,12},{4,10,14},{5,9,13},{5,11,16},{6,9,17},{6,11,15},{7,13,18},{7,14,16},{8,15,18},{10,17,18},{12,16,17}};

Show[ConfigurationDiagram[v1,lines,.3],AspectRatio->1]

Show[ConfigurationDiagram[v2,lines,.5],AspectRatio->1]

{g1,g2}=ConfigurationGraph[#,lines]&/@{v1,v2}

IsomorphicGraphQ@@{g1,g2}

g1=ConfigurationGraph[v1,lines]

levi=LeviGraph[lines]

RecognizeGraph@levi

{"Configuration", {{18, 3}, 2}}

Marko Boben, Tomaz Pisanski, Arjana Zitnik, Branko Grunbaum
Small Triangle Free Configurations of Points and Lines
https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

lines={{1,2,3},{1,4,5},{1,6,7},{2,8,9},{2,10,11},{3,12,13},{3,14,15},{4,8,12},{4,10,14},{5,9,13},{5,16,17},{6,9,15},{6,10,16},{7,13,18},{7,14,17},{8,16,18},{11,12,17},{11,15,18}};

RecognizeGraph@LeviGraph[lines]

{"Configuration", {{18, 3}, 3}}

Marko Boben, Tomaz Pisanski, Arjana Zitnik, Branko Grunbaum
Small Triangle Free Configurations of Points and Lines
https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

lines={{1,2,3},{1,4,5},{1,6,7},{2,8,9},{2,10,11},{3,12,13},{3,14,15},{4,8,16},{4,10,12},{5,9,13},{5,17,18},{6,8,17},{6,10,14},{7,9,15},{7,12,18},{11,13,16},{11,15,17},{14,16,18}};

RecognizeGraph@LeviGraph[lines]

{"Configuration", {{18, 3}, 4}}

Marko Boben, Tomaz Pisanski, Arjana Zitnik, Branko Grunbaum
Small Triangle Free Configurations of Points and Lines
https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

lines={{1,5,10},{2,6,11},{3,7,12},{4,8,13},{5,9,14},{6,1,15},{7,2,16},{8,3,17},{9,4,18},{1,18,16},{2,10,17},{3,11,18},{4,12,10},{5,13,11},{6,14,12},{7,15,13},{8,16,14},{9,17,15}};

RecognizeGraph@LeviGraph[lines]

(Subscript[18, 4])

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

Module[{config18,linesconfig18,inf},config18={{0,Root[9-141 ((#1)^2)+((#1)^4)&,1]},{(1/4) (-21-9 (Sqrt[5])),Root[9-564 ((#1)^2)+16 ((#1)^4)&,4]},{(1/4) (21+9 (Sqrt[5])),Root[9-564 ((#1)^2)+16 ((#1)^4)&,4]},{0,-2 (Sqrt[3])},{-3,(Sqrt[3])},{3,(Sqrt[3])},{0,(Sqrt[3])},{(3/2),-((Sqrt[3])/2)},{-(3/2),-((Sqrt[3])/2)},{(1/4) (3+3 (Sqrt[5])),Root[9-564 ((#1)^2)+16 ((#1)^4)&,4]},{(1/4) (9+3 (Sqrt[5])),Root[225-420 ((#1)^2)+16 ((#1)^4)&,1]},{(1/2) (-6-3 (Sqrt[5])),-((Sqrt[3])/2)},{0,Root[144-564 ((#1)^2)+((#1)^4)&,4]},{(1/2) (21+9 (Sqrt[5])),Root[9-141 ((#1)^2)+((#1)^4)&,1]},{(1/2) (-21-9 (Sqrt[5])),Root[9-141 ((#1)^2)+((#1)^4)&,1]}};
linesconfig18=SplitBy[SortBy[Union[Flatten[First[#],1]]&/@
(Transpose/@Select[
SplitBy[SortBy[{#, RootReduce[RowReduce[Append[#,1]&/@#]]}&/@Subsets[config18,{2}],Last],Last],Length[#]>1&]),Length],Length];
inf =Select[ SplitBy[SortBy[linesconfig18[[1]],RootReduce[slope[Take[#,2]]]&],RootReduce[slope[Take[#,2]]]&],Length[#]>3&];
Graphics[{Thick, Line/@linesconfig18[[2]], Red, InfiniteLine[Take[#,2]]&/@inf[[1]], Green, InfiniteLine[Take[#,2]]&/@inf[[2]], Blue, InfiniteLine[Take[#,2]]&/@inf[[3]], EdgeForm[Black],White,Disk[#,.7]&/@config18}, ImageSize-> {520,460}]]

points={{0,Root[9-141 ((#1)^2)+((#1)^4)&,1]},{(1/4) (-21-9 (Sqrt[5])),Root[9-564 ((#1)^2)+16 ((#1)^4)&,4]},{(1/4) (21+9 (Sqrt[5])),Root[9-564 ((#1)^2)+16 ((#1)^4)&,4]},{0,-2 (Sqrt[3])},{-3,(Sqrt[3])},{3,(Sqrt[3])},{0,(Sqrt[3])},{(3/2),-((Sqrt[3])/2)},{-(3/2),-((Sqrt[3])/2)},{(1/4) (3+3 (Sqrt[5])),Root[9-564 ((#1)^2)+16 ((#1)^4)&,4]},{(1/4) (9+3 (Sqrt[5])),Root[225-420 ((#1)^2)+16 ((#1)^4)&,1]},{(1/2) (-6-3 (Sqrt[5])),-((Sqrt[3])/2)},{0,Root[144-564 ((#1)^2)+((#1)^4)&,4]},{(1/2) (21+9 (Sqrt[5])),Root[9-141 ((#1)^2)+((#1)^4)&,1]},{(1/2) (-21-9 (Sqrt[5])),Root[9-141 ((#1)^2)+((#1)^4)&,1]}};

alllines=ResourceFunction["FindExtraordinaryLines"][points]

Tally[Length/@alllines]

20

(Subscript[20, 3]) unique flag-transitive triangle free

Marko Boben, Tomaz Pisanski, Arjana Zitnik, Branko Grunbaum
Small Triangle Free Configurations of Points and Lines
https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

lines={{5,7,15},{4,6,14},{3,5,13},{2,4,12},{1,3,11},{2,10,20},{1,9,19},{8,10,18},{7,9,17},{6,8,16},{5,12,16},{4,11,15},{3,14,20},{2,13,19},{1,12,18},{10,11,17},{9,16,20},{8,15,19},{7,14,18},{6,13,17}};

RecognizeGraph@LeviGraph[lines]

GraphData["Foster040A","Graph","All"]

GraphData["Foster040A","IncidenceLines"]

(Subscript[20, 4])

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

21

(Subscript[21, 3])

(Subscript[21, 4]) == "GruenbaumRigbyConfigurationGraph" (Levi graph "GruenbaumRigbyGraph")

GraphData["GruenbaumRigbyConfigurationGraph"]

Select[ConfigurationLinesFromGraph[GraphData["GruenbaumRigbyConfigurationGraph"]],Length[#]==4&]

LeviGraph[%]//RecognizeGraph

24

(Subscript[24, 3]) == Pegg Self-Dual Configuration

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

full=Union[Flatten[{#, RotateRight[#,1],RotateLeft[#,1]}&/@
{{-1,0,2},{-1,1,2},{-1,2,0},{-1,2,1},{-1,2,4},{-1,4,2},{0,1,2},{0,2,1}},1]];

A barycentric line and barycentric coordinates have the same format.  {2,4,-1}  is both a barycentric point and a barycentric line:

Table[Select[full,#.full[[n]]==0&],{n,1,24}]

FromBarycentrics[{m_,n_,o_},{{x1_,y1_},{x2_,y2_},{x3_,y3_}}]:={m*x1+n*x2+(1-m-n)*x3,m*y1+n*y2+(1-m-n)*y3};
tri=Reverse[{{((Sqrt[3])/2),-(1/2)},{0,1},{-((Sqrt[3])/2),-(1/2)}}];With[{full=Union[Flatten[{#, RotateRight[#,1],RotateLeft[#,1]}&/@
{{-1,0,2},{-1,1,2},{-1,2,0},{-1,2,1},{-1,2,4},{-1,4,2},{0,1,2},{0,2,1}},1]]},
Graphics[{EdgeForm[Black],Tooltip[Line[#[[2]]],Style[Row[
Switch[Sign[#],-1,Style[ToString[Abs[#]],Red],0,Style[ToString[Abs[#]],Darker[Green]],1,Style[ToString[Abs[#]],Blue]]&/@#[[1]]],16,Bold]]&/@Table[{full[[k]],Sort[FromBarycentrics[#/Total[#],tri]&/@
Select[full,full[[k]].#==0&]]},{k,1,Length[full]}],White,{Disk[FromBarycentrics[#/Total[#],tri],.15],Black, Style[Text[Row[Switch[Sign[#],-1,Style[ToString[Abs[#]],Red],0,
Style[ToString[Abs[#]],Darker[Green]],1,Style[ToString[Abs[#]],Blue]]&/@#],FromBarycentrics[#/Total[#],tri]],14,Bold]}&/@full}, ImageSize-> 520]]

points=Cases[,Disk[x_,_]:>x,∞]

alllines=ResourceFunction["FindExtraordinaryLines"][points]

Tally[Length/@alllines]

lines=Select[alllines,Length[#]==3&]

Subscript@@Reverse@Flatten@Tally[Length/@lines]

ConfigurationDiagram[points,lines,.5,VertexLabels->Automatic]

ConfigurationGraph[points,lines]

LeviGraph[lines]//RecognizeGraph

(Subscript[24, 4])

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

25

(Subscript[25, 4])

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

27

(Subscript[27, 3]) == "GrayConfigurationGraph" == {"Grid", {3, 3, 3}}

GraphData["GrayConfigurationGraph","StandardName"]

(Subscript[27, 4]) #1

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

(Subscript[27, 4]) #2

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

(Subscript[27, 4]) == Pegg Self-Dual Configuration

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

lines=Union[Flatten[{#, RotateRight[#,1],RotateLeft[#,1]}&/@{{-2,-1,4},{-2,1,3},{-1,1,1},{-1,2,0},{-1,2,1},{-1,3,2},{-1,4,2},{0,1,2},{1,1,2}},1]]

27 areal points, each on four lines.
27 areal lines, each on four points.

With[{full=Union[Flatten[{#, RotateRight[#,1],RotateLeft[#,1]}&/@{{-2,-1,4},{-2,1,3},{-1,1,1},{-1,2,0},{-1,2,1},{-1,3,2},{-1,4,2},{0,1,2},{1,1,2}},1]]},
Graphics[{EdgeForm[Black],Tooltip[Line[#[[2]]],Style[Row[
Switch[Sign[#],-1,Style[ToString[Abs[#]],Red],0,Style[ToString[Abs[#]],Darker[Green]],1,Style[ToString[Abs[#]],Blue]]&/@#[[1]]],16,Bold]]&/@Table[{full[[k]],Sort[FromBarycentrics[#/Total[#],tri]&/@Select[full,full[[k]].#==0&]]},{k,1,Length[full]}],White,{Tooltip[Disk[FromBarycentrics[#/Total[#],tri],.08], Style[Row[Switch[Sign[#],-1,Style[ToString[Abs[#]],Red],0,Style[ToString[Abs[#]],Darker[Green]],1,Style[ToString[Abs[#]],Blue]]&/@#],16,Bold]]}&/@full}, ImageSize-> 520]]

points=Cases[,Disk[x_,_]:>x,∞]

alllines=ResourceFunction["FindExtraordinaryLines"][points]

Tally[Length/@alllines]

lines=Select[alllines,Length[#]==4&]

Subscript@@Reverse@Flatten@Tally[Length/@lines]

ConfigurationDiagram[points,lines,.5,VertexLabels->Automatic]

ConfigurationGraph[points,lines]

LeviGraph[lines]//RecognizeGraph

28

(Subscript[28, 3]) == "CoxeterConfigurationGraph" #1 (Levi graph "Foster056C")

https://arxiv.org/pdf/1301.1067.pdf

16/.Import["https://arxiv.org/pdf/1301.1067.pdf","EmbeddedImages"]

pts={{-0.2623121108935409`,-0.42246887454555027`},{-0.001377052234304372`,1.000449824825443`},{0.2530359113130905`,0.7616565743258589`},{-0.44023311591704495`,0.6662200437372208`},{-0.781273553181782`,0.622347697988046`},{0.052234825855965325`,0.498222874120828`},{-0.17248225086514182`,0.45973215446386434`},{-0.34941859924384`,0.35318634254727194`},{0.2525233694575428`,0.4272870813130529`},{0.7809952577853773`,0.6213584520417191`},{0.7439741276492716`,0.2827630915950442`},{0.4212393347573939`,0.2643372118881112`},{-0.46919963088529276`,0.15533237275954478`},{0.4911116032149082`,0.06479185397707742`},{0.4687775918594255`,-0.16487815149376106`},{-0.4942373005287886`,-0.05747500566378071`},{-0.7971110965182002`,0.07654187601550407`},{0.3593242786072548`,-0.3445881395951061`},{-0.41068294290666435`,-0.28068307044963037`},{-0.9798450815672757`,-0.21934853719207256`},{0.9744642000889863`,-0.22016860416094852`},{0.6857621864054633`,-0.41039851384740655`},{0.169465961766069`,-0.4693792678745359`},{-0.04689076900692285`,-0.4934943621780464`},{0.10739664186842215`,-0.7880706137022256`},{-0.5595735735647073`,-0.5822537980124859`},{0.4357314557229998`,-0.8997606639777788`},{-0.431399669038664`,-0.9012598489052551`}};
lines=Sort[Sort/@{{5,4,3},{2,3,11},{10,11,22},{21,22,25},{27,25,26},{28,26,17},{20,17,4},{20,19,18},{28,1,6},{25,1,19},{16,15,21},{21,14,7},{10,12,1},{10,9,13},{19,7,2},{2,6,23},{3,12,14},{5,8,15},{5,13,24},{9,18,27},{27,23,8},{28,24,14},{20,16,12},{4,6,9},{17,8,7},{26,16,13},{18,15,11},{24,23,22}}]

Mean[pts]

{Mean[#],Length[#]}&/@Split[Sort[Norm/@pts],Abs[#-#2]<.01&]

Sort[ArcTan@@@Select[pts,Abs[Norm[#]-.5]<.1&]]

2Pi-Mod[Subtract@@@Partition[%,2,1,1],2Pi]

Length[lines]

VertexDegree[]

VertexDegree[]

ConfigurationDiagram[pts,lines]

cg=ConfigurationGraph[pts,lines]

RecognizeGraph@LeviGraph[lines]

(Subscript[28, 3]) == "CoxeterConfigurationGraph" #2 (Levi graph "Foster056C")

7-fold rotationally symmetric construction #1

Danzer’s configuration revisited
Boben, Gevay, and Psanski
https://arxiv.org/pdf/1301.1067.pdf

16/.Import["https://arxiv.org/pdf/1301.1067.pdf","EmbeddedImages"]

pts={{0.03752282837525686`,0.21676715029386778`},{-0.7917755891769612`,0.6203269391075783`},{-0.2745392974971508`,0.24321415356984813`},{-0.1554726857231675`,0.1645697158443058`},{-0.07866146106333771`,0.16074490383722573`},{0.08730890796379226`,0.15753593423583134`},{0.02051366439083045`,0.35927514589883625`},{-0.00285889374575037`,1.`},{0.7877259552227568`,0.6244471124602756`},{0.30237203775788896`,0.20288071622863973`},{0.199900353538122`,0.10608774701359178`},{-0.14823642466783754`,-0.1203328127899426`},{0.18196572887792437`,0.028046426085709515`},{-0.17981648920352347`,0.0399708399901355`},{-0.23459414836139342`,-0.024583368127043762`},{-0.3684022200467261`,-0.06649392717164394`},{0.9831513498903844`,-0.22857596069519814`},{0.3513570216767993`,-0.1112565759875287`},{0.21361178079310575`,-0.09065303308579231`},{0.13915751739790275`,-0.13010068795831572`},{0.064751790028381`,-0.2279978517576147`},{-0.007166466024970792`,-0.19272429509368783`},{-0.13617522228602`,-0.20040512115776268`},{-0.9844219421281964`,-0.23442567317661453`},{0.13675498412667544`,-0.3530994579513144`},{-0.18594891662225232`,-0.32915906328398475`},{0.44349053242643666`,-0.9171851484200554`},{-0.4374626017030489`,-0.9162508299256893`}};
Length[lines={{8,15,28},{8,11,27},{8,6,25},{24,4,9},{9,13,26},{9,19,28},{27,23,2},{27,22,3},{28,12,7},{24,21,17},{24,14,10},{2,1,17},{2,5,18},{17,20,16},{3,1,10},{10,19,25},{25,23,16},{16,4,7},{7,11,18},{18,21,26},{26,15,3},{15,14,5},{23,12,14},{4,5,6},{11,13,20},{12,22,21},{1,6,13},{22,20,19}}]

g=Graph[Range[Length[pts]],UndirectedEdge@@@Flatten[Partition[#,2,1]&/@lines,1],VertexCoordinates->pts,VertexLabels->Automatic]

VertexDegree[g]

RecognizeGraph[g]

RecognizeGraph@LeviGraph[lines]

(Subscript[28, 3]) Circles

Boben et al.

35

(Subscript[35, 4]) == "DanzerConfigurationGraph"

GraphData["DanzerConfigurationGraph","StandardName"]

48

(Subscript[48, 5]) == "Berman485ConfigurationGraph"

96

(Subscript[96, 6]) == "Berman966ConfigurationGraph"

Embeddings

<<MathWorld`Graphs`

GraphData["*Configuration*"]

Length[%]

"Berman485ConfigurationGraph"

"Berman966ConfigurationGraph"

{"Configuration", {{9, 3}, 1}}

GraphData[{"Configuration",{{9,3},1}},"StandardName"]

Names

GraphData[{"Configuration",{{9,3},1}},"StandardName"]

GraphData[{"Configuration",{{9,3},1}},"StandardNames"]

Primary

GraphData[{"Configuration",{{9,3},1}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

GraphData[{"Configuration",{{9,3},1}},"Graph","Configuration"]//StyleGraphs

lines=ConfigurationLinesFromGraph[GraphData[{"Configuration",{{9,3},1}},"Graph","Configuration"][[1]]]

LeviGraph[lines]//RecognizeGraph

All

GraphData[{"Configuration",{{9,3},1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"Configuration",{{9,3},1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{9,3},1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{9,3},1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{9,3},1}},"Graph","Degenerate"]//StyleGraphs

Configuration construction

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

points={{(Sqrt[3]),-1},{0,2},{-(Sqrt[3]),-1},{(NumericalApproximation[Root, (RowDefault["-1.07", FEExpressionsNumericalApproximationElider]), Root[9-9 ((#1)^2)+((#1)^4)&,2], ]),(1/2) (7-3 (Sqrt[5]))},{(NumericalApproximation[Root, (RowDefault["0.409", FEExpressionsNumericalApproximationElider]), Root[9-54 ((#1)^2)+((#1)^4)&,3], ]),-1},{(NumericalApproximation[Root, (RowDefault["0.662", FEExpressionsNumericalApproximationElider]), Root[9-21 ((#1)^2)+((#1)^4)&,3], ]),(1/2) (-5+3 (Sqrt[5]))},{0,-7+3 (Sqrt[5])},{(NumericalApproximation[Root, (RowDefault["0.253", FEExpressionsNumericalApproximationElider]), Root[9-141 ((#1)^2)+((#1)^4)&,3], ]),(1/2) (7-3 (Sqrt[5]))},{(NumericalApproximation[Root, (RowDefault["-0.253", FEExpressionsNumericalApproximationElider]), Root[9-141 ((#1)^2)+((#1)^4)&,2], ]),(1/2) (7-3 (Sqrt[5]))}};
lines=ResourceFunction["FindExtraordinaryLines"][points];
ConfigurationGraph[points,lines]//Quiet

RecognizeGraph@%

LeviGraph[lines]//RecognizeGraph

Configuration

config=GraphData[{"Configuration",{{9,3},1}},"Graph",{"Labeled","Configuration"}][[1]]//StyleGraphs

GraphData[{"Configuration",{{9,3},1}},"IncidenceLines"]

lines=ConfigurationLines[GraphData[{"Configuration",{{9,3},1}}]]

levi=LeviGraph[lines]

RecognizeGraph@levi

olg=OrdinaryLineGraph[config]

RecognizeGraph@olg

Bilateral

GraphData[{"Configuration",{{9,3},1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{9,3},1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{9,3},1}}],All][[All,All,1]]]

gs=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{9,3},1}}],#]&/@hc

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

Planar

GraphData[{"Configuration",{{9,3},1}},"Planar"]

GraphData[{"Configuration",{{9,3},1}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{9,3},1}},{"RCN","CN"}]

GraphData[{"Configuration",{{9,3},1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{9,3},1}}],TimeConstraint->10])//AbsoluteTiming

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{9,3},1}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

GraphPlot@RotateGraph[,-.5]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{9,3},1}},"Circulant"]

GraphData[{"Configuration",{{9,3},1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"Configuration",{{9,3},1}},"Halin"]

GraphData[{"Configuration",{{9,3},1}},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"Configuration",{{9,3},1}},"LCF"]

GraphData[{"Configuration",{{9,3},1}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{9,3},1}},"LCFSignature"]

GraphData[{"Configuration",{{9,3},1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"Configuration",{{9,3},1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{9,3},1}}],Debug->True]//Timing

GraphData[{"Configuration",{{9,3},1}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{9,3},1}},"VertexList"],GraphData[{"Configuration",{{9,3},1}},"EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

GraphPlot@

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{9,3},1}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData[{"Configuration",{{9,3},1}},"Matchstick"]

GraphData[{"Configuration",{{9,3},1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{9,3},1}},"Edges"]]

3D All

GraphData[{"Configuration",{{9,3},1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{9,3},1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{9,3},1}},"Polyhedral"]

GraphData[{"Configuration",{{9,3},1}},"Graph",{"3D","Polyhedron"}]

{"Configuration", {{9, 3}, 2}}

Names

GraphData[{"Configuration",{{9,3},2}},"StandardName"]

GraphData[{"Configuration",{{9,3},2}},"StandardNames"]

Primary

GraphData[{"Configuration",{{9,3},2}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

config=GraphData[{"Configuration",{{9,3},2}},"Graph",{"Labeled","Configuration"}][[1]]//StyleGraphs

GraphData[{"Configuration",{{9,3},2}},"IncidenceLines"]

lines=ConfigurationLines[GraphData[{"Configuration",{{9,3},2}}]]

levi=LeviGraph[lines]

RecognizeGraph@levi

olg=OrdinaryLineGraph[config]

RecognizeGraph@olg

All

GraphData[{"Configuration",{{9,3},2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"Configuration",{{9,3},2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{9,3},2}},"EdgeList"]]

Default embedding

RotateGraph[Graph@GraphData[{"Configuration",{{9,3},2}},"Edges"],.33]

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

RecognizeGraph[g]

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

points=Join[2 CirclePoints[3],-CirclePoints[3],
RootReduce[1/GoldenRatio #[[1]] + (1-1/GoldenRatio)#[[2]] &/@ Partition[-CirclePoints[3],2,1,1]]];
lines=ResourceFunction["FindExtraordinaryLines"][points];
g=ConfigurationGraph[points,lines]

RecognizeGraph@g

Degenerate

GraphData[{"Configuration",{{9,3},2}},"Graph","Degenerate"]//StyleGraphs

Configuration

GraphData[{"Configuration",{{9,3},2}},"Graph","Configuration"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{9,3},2}},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"Configuration",{{9,3},2}},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]

Circular

GraphData[{"Configuration",{{9,3},2}},"Graph","Circular"]//StyleGraphs

Circular construction

GraphData[{"Configuration",{{9,3},2}},"Hamiltonian"]

GraphData[{"Configuration",{{9,3},2}},"HamiltonianCycleCount"]

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{9,3},2}}],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{9,3},2}}],#]&/@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[{"Configuration",{{9,3},2}},"Planar"]

GraphData[{"Configuration",{{9,3},2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"Configuration",{{9,3},2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"Configuration",{{9,3},2}}],"OuterFace"->#]&/@faces

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

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Circulant

GraphData[{"Configuration",{{9,3},2}},"Circulant"]

GraphData[{"Configuration",{{9,3},2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"Configuration",{{9,3},2}},"Halin"]

GraphData[{"Configuration",{{9,3},2}},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"Configuration",{{9,3},2}},"LCF"]

GraphData[{"Configuration",{{9,3},2}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{9,3},2}},"LCFSignature"]

GraphData[{"Configuration",{{9,3},2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"Configuration",{{9,3},2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{9,3},2}}],Debug->True]//Timing

GraphData[{"Configuration",{{9,3},2}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{9,3},2}},"VertexList"],GraphData[{"Configuration",{{9,3},2}},"EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

gs=LabelGraph/@{RotateGraph[,{5,2}],RotateGraph[,{2,3}]}

Near-UnitDistance Construction 1

EdgeLengths@(g0=)

pts=Join[CirclePoints[{1,-Pi/2},3],CirclePoints[{2,Pi/2},3],CirclePoints[{1/3,Pi/2},3]][[{7,5,6,9,4,8,3,1,2}]]/(Sqrt[3]);
g=Graph[Range@Length@pts,EdgeList[g0],VertexCoordinates->pts,VertexLabels->Automatic]

RecognizeGraph@g

EuclideanDistance@@pts[[{7,9}]]

Minimize the sum of ((((Subscript[l, i]^2)-1))^2) with a==1

pts=Join[CirclePoints[{a,-Pi/2},3],CirclePoints[{b,Pi/2},3],CirclePoints[{c,Pi/2},3]][[{7,5,6,9,4,8,3,1,2}]]/(Sqrt[3]);

EdgeCount[g0]

eqn=Tally[(Simplify[SquaredEuclideanDistance@@@(List@@@EdgeList[g0]/.i_Integer:>pts[[i]]),(a|b|c)∈Reals]-1)^2]

sum=Total[Times@@@eqn/.a->1]//Simplify

{min,vals}=Minimize[sum,{b,c}]//FullSimplify

vnew=RootReduce[pts/.Append[vals,a->1]]

g=Graph[Range@Length@pts,EdgeList[g0],VertexCoordinates->vnew]

RecognizeGraph@g

EdgeLengths[g]//RootReduce

Minimize the sum of ((((Subscript[l, i]^2)-1))^2) letting a vary:

pts=Join[CirclePoints[{a,-Pi/2},3],CirclePoints[{b,Pi/2},3],CirclePoints[{c,Pi/2},3]][[{7,5,6,9,4,8,3,1,2}]]/(Sqrt[3]);

EdgeCount[g0]

eqn=Tally[(Simplify[SquaredEuclideanDistance@@@(List@@@EdgeList[g0]/.i_Integer:>pts[[i]]),(a|b|c)∈Reals]-1)^2]

sum=Total[Times@@@eqn]//Simplify

({min,vals}=Minimize[sum,{a,b,c},PositiveReals])//Timing

N[3 ,10]

vnew=Simplify[pts/.vals]

(vexact=Map[ToAlgebraicRoot,vnew,{2}])//Timing

N[vnew-vexact,10^3]//Timing

N[vnew-vexact,1*^4]//Timing

g=Graph[Range@Length@vexact,EdgeList[g0],VertexCoordinates->vexact]

RecognizeGraph@g

Tally[EdgeLengths[g]//RootReduce]

gs=UnlabelGraph/@{,}

Near-UnitDistance Construction 2

(g=UnitDistanceEmbeddingRefine[,PrecisionGoal->1000,AccuracyGoal->1000,MaxIterations->500])//Timing

g=Bilateralize@

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{9,3},2}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData[{"Configuration",{{9,3},2}},"Matchstick"]

GraphData[{"Configuration",{{9,3},2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{9,3},2}},"Edges"]]

3D All

GraphData[{"Configuration",{{9,3},2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{9,3},2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{9,3},2}},"Polyhedral"]

GraphData[{"Configuration",{{9,3},2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"Configuration",{{9,3},2}},"Polyhedron"]}]

3D Canonical

GraphData[{"Configuration",{{9,3},2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"Configuration",{{9,3},2}},"Polyhedron","Canonical"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"Configuration",{{9,3},2}}],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->1000,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

pts=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@pts[[#]]],Line[pts[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"Configuration", {{9, 3}, 3}} == "PappusConfigurationGraph"

Names

GraphData[{"Configuration",{{9,3},3}},"StandardName"]

GraphData[{"Configuration",{{9,3},3}},"StandardNames"]

{"Configuration", {{10, 3}, 1}} == "DesarguesConfigurationGraph"

Names

GraphData[{"Configuration",{{10,3},1}},"StandardName"]

GraphData[{"Configuration",{{10,3},1}},"StandardNames"]

{"Configuration", {{10, 3}, 2}}

Names

GraphData[{"Configuration",{{10,3},2}},"StandardName"]

GraphData[{"Configuration",{{10,3},2}},"StandardNames"]

Primary

GraphData[{"Configuration",{{10,3},2}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

GraphData[{"Configuration",{{10,3},2}},"Graph","Configuration"]//StyleGraphs

config=%[[1]]

ConfigurationDiagram[config,2]

lines=ConfigurationLinesFromGraph[config]

LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[%,"StandardNames"],{"Incidence",_}]

All

GraphData[{"Configuration",{{10,3},2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"Configuration",{{10,3},2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{10,3},2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},2}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},2}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},2}}],All][[All,All,1]]]

gs=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},2}}],#]&/@hc

g=gs[[1]]

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

Planar

GraphData[{"Configuration",{{10,3},2}},"Planar"]

GraphData[{"Configuration",{{10,3},2}},"Graph","Planar"]//StyleGraphs

MinimalLocalCrossing

GraphData[{"Configuration",{{10,3},2}},"LocalCrossingNumber"]

GraphData[{"Configuration",{{10,3},2}},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalLocalCrossing construction

GraphPlot@

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

RecognizeGraph@g

LocalCrossingCount@g

MinimalCrossing

GraphData[{"Configuration",{{10,3},2}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},2}}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},2}}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},2}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},2}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

GraphPlot@

GraphPlot@

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},2}},"Circulant"]

GraphData[{"Configuration",{{10,3},2}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},2}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},2}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},2}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},2}}&]

RootGraph[GraphData[{"Configuration",{{10,3},2}}]]

Halin

GraphData[{"Configuration",{{10,3},2}},"Halin"]

GraphData[{"Configuration",{{10,3},2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},2}},"Rigid"]

GraphData[{"Configuration",{{10,3},2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},2}},"Flexible"]

GraphData[{"Configuration",{{10,3},2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},2}},"LCF"]

GraphData[{"Configuration",{{10,3},2}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},2}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},2}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},2}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},2}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},2}},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{10,3},2}},"VertexList"],GraphData[{"Configuration",{{10,3},2}},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},2}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},2}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},2}},"Matchstick"]

GraphData[{"Configuration",{{10,3},2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},2}},"Edges"]]

3D All

GraphData[{"Configuration",{{10,3},2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{10,3},2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{10,3},2}},"Polyhedral"]

GraphData[{"Configuration",{{10,3},2}},"Graph",{"3D","Polyhedron"}]

{"Configuration", {{10, 3}, 3}}

Names

GraphData[{"Configuration",{{10,3},3}},"StandardName"]

GraphData[{"Configuration",{{10,3},3}},"StandardNames"]

Primary

GraphData[{"Configuration",{{10,3},3}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

GraphData[{"Configuration",{{10,3},3}},"Graph","Configuration"]//StyleGraphs

config=%[[1]]

ConfigurationDiagram[config,3]

lines=ConfigurationLinesFromGraph[config]

LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[%,"StandardNames"],{"Incidence",_}]

All

GraphData[{"Configuration",{{10,3},3}},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},3}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{10,3},3}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},3}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},3}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},3}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},3}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},3}}],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},3}}],#]&/@hc

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

Planar

GraphData[{"Configuration",{{10,3},3}},"Planar"]

GraphData[{"Configuration",{{10,3},3}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{10,3},3}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},3}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},3}}],TimeConstraint->1])//AbsoluteTiming

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

(g=MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},3}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},3}}],"CrossingNumber"->cn,RandomSeed->i],{i,500}]//Union

GraphPlot@

RegionIntersection[Line[pts[[{3,5}]]],InfiniteLine[pts[[{9,6}]]]]

pts=CirclePoints[{1,-Pi/2},4];
pts=Join[pts,Delete[Subdivide[pts[[4]],pts[[2]],6][[2;;-2]],3],{pts[[1]]/2,{-(1/2),(1/4)}}];
g=Graph[Range[Length[pts]],UndirectedEdge@@@{e[5,1,2,3,4,1,9,3,10,5],e[4,5,6,7,8,2],e[9,6,10],e[6,3,8,1,7]},VertexCoordinates->pts,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},3}},"Circulant"]

GraphData[{"Configuration",{{10,3},3}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},3}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},3}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},3}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},3}}&]

RootGraph[GraphData[{"Configuration",{{10,3},3}}]]

Halin

GraphData[{"Configuration",{{10,3},3}},"Halin"]

GraphData[{"Configuration",{{10,3},3}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},3}},"Rigid"]

GraphData[{"Configuration",{{10,3},3}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},3}},"Flexible"]

GraphData[{"Configuration",{{10,3},3}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},3}},"LCF"]

GraphData[{"Configuration",{{10,3},3}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},3}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},3}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},3}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},3}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},3}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},3}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{10,3},3}},"VertexList"],GraphData[{"Configuration",{{10,3},3}},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},3}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},3}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},3}},"Matchstick"]

GraphData[{"Configuration",{{10,3},3}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},3}},"Edges"]]

3D All

GraphData[{"Configuration",{{10,3},3}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{10,3},3}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{10,3},3}},"Polyhedral"]

GraphData[{"Configuration",{{10,3},3}},"Graph",{"3D","Polyhedron"}]

{"Configuration", {{10, 3}, 4}} [no Euclidean plane realization]

Names

GraphData[{"Configuration",{{10,3},4}},"StandardName"]

GraphData[{"Configuration",{{10,3},4}},"StandardNames"]

Primary

GraphData[{"Configuration",{{10,3},4}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

GraphData[{"Configuration",{{10,3},3}},"Graph","Configuration"]//StyleGraphs

lines=ConfigurationLinesFromGraph[GraphData[{"Configuration",{{9,3},1}},"Graph","Configuration"][[1]]]

LeviGraph[lines]//RecognizeGraph

All

GraphData[{"Configuration",{{10,3},4}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"Configuration",{{10,3},4}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},4}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

From Ed Pegg, Jr.
Dec 18, 2023

Here’s a version of Kantor’s “close” configuration #4. The lines through point 9 don’t actually coincide.

con4={{0,2},{2 (Sqrt[2]),2},{2,2},{0,-(1/(Sqrt[2]))},{0,0},{4,-2},{2,0},{(1/73) (208-30 (Sqrt[2])),(1/73) (22+60 (Sqrt[2]))},{(1/267) (392+94 (Sqrt[2])),((13568+15630 (Sqrt[2]))/25899)},{(1/7) (-4-8 (Sqrt[2])),0}};
lin4=({{0,9,8},{0,4,6},{0,5,7},{1,2,3},{1,4,5},{1,6,7},{2,4,8},{2,9,5},{3,6,8},{3,9,7}}/. 0->10);
Graphics[{Line[con4[[#]]]&/@lin4,Red, Point[con4],Blue, Table[Text[k,con4[[k]]+{-.1,.1}],{k,1,10}]}]

Degenerate

GraphData[{"Configuration",{{10,3},4}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},4}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},4}},"Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData[{"Configuration",{{10,3},4}},"Polyhedron"]

PolyhedronGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"]]

Manipulate[PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{x,y,z}],{x,-1,1},{y,-1,1},{z,-1,1}]

PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{0,.01,.01}]

PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{0,0,1}]

PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{0,1,0}]

PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{1,0.01,0}]

PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{1,1,0}]

PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{1,0,1,-Pi/2}]

PolyhedronProjectionGraph[GraphData[{"Configuration",{{10,3},4}},"Polyhedron"],{1,1,1}]

Bilateral

GraphData[{"Configuration",{{10,3},4}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},4}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},4}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},4}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

gs=bilat

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

quad

Planar

GraphData[{"Configuration",{{10,3},4}},"Planar"]

GraphData[{"Configuration",{{10,3},4}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"Configuration",{{10,3},4}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"Configuration",{{10,3},4}}],"OuterFace"->#]&/@faces

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

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"Configuration",{{10,3},4}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},4}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},4}}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},4}}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},4}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},4}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},4}},"Circulant"]

GraphData[{"Configuration",{{10,3},4}},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"Configuration",{{10,3},4}},"NotationRules"]

ci=CirculantIndices[GraphData[{"Configuration",{{10,3},4}}]]

CirculantGraph1@@@ci

gs=CirculantGraph1@@@Cases[GraphData[{"Configuration",{{10,3},4}},"StandardNames"],{"Circulant",i_}:>i]

Complement graph

GraphData[{"Configuration",{{10,3},4}},"ComplementGraph","Name"]

GraphComplement/@GraphData[%,"Graph","All"]

Line graph

GraphData[{"Configuration",{{10,3},4}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},4}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},4}}&]

RootGraph[GraphData[{"Configuration",{{10,3},4}}]]

Halin

GraphData[{"Configuration",{{10,3},4}},"Halin"]

GraphData[{"Configuration",{{10,3},4}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},4}},"Rigid"]

GraphData[{"Configuration",{{10,3},4}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},4}},"Flexible"]

GraphData[{"Configuration",{{10,3},4}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},4}},"LCF"]

GraphData[{"Configuration",{{10,3},4}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},4}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},4}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},4}},"Graph","LCF"]//StyleGraphs

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

LCF compute random

FindRandomLCFNotation[GraphData[{"Configuration",{{10,3},4}}],TimeConstraint->120]

LCF compute 10^5

Tally[(lcf=LCF[GraphData[{"Configuration",{{10,3},4}}],10^5])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute all

Divisors[GraphData[{"Configuration",{{10,3},4}},"V"]]

Length[FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},4}}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"Configuration",{{10,3},4}}],All])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName[{"Configuration",{{10,3},4}},".m.gz"]])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

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

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

i=0;
gs={};
t0=AbsoluteTime[];
count=Length[order2];
Monitor[
Do[
If[!MissingQ[g=BilateralLCFGraph[LCFGraph@@order2[[i]]]],AppendTo[gs,g]],
{i,count}
],
Column[{
ProgressIndicator[i,{1,count}],
Row[{i,"/",count}],
Row[{"estimated time remaining: ",Round[(AbsoluteTime[]-t0) (count/i-1)]," s"}],
Row[{Length[gs]," bilateral graphs"}]
}]
];//Timing

UnitDistance

GraphData[{"Configuration",{{10,3},4}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},4}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},4}},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{10,3},4}},"VertexList"],GraphData[{"Configuration",{{10,3},4}},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},4}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},4}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{{"Configuration",{{10,3},4}},l=FindSubgraphUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},4}}],TimeConstraint->300,"Results"->All]//Timing}

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

Matchstick

GraphData[{"Configuration",{{10,3},4}},"Matchstick"]

GraphData[{"Configuration",{{10,3},4}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},4}},"Edges"]]

3D All

GraphData[{"Configuration",{{10,3},4}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{10,3},4}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{10,3},4}},"Polyhedral"]

GraphData[{"Configuration",{{10,3},4}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"Configuration",{{10,3},4}},"Polyhedron"]}]

{"Configuration", {{10, 3}, 5}}

Names

GraphData[{"Configuration",{{10,3},5}},"StandardName"]

GraphData[{"Configuration",{{10,3},5}},"StandardNames"]

Primary

GraphData[{"Configuration",{{10,3},5}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

GraphData[{"Configuration",{{10,3},5}},"Graph","Configuration"]//StyleGraphs

config=%[[1]]

ConfigurationDiagram[config,2]

lines=ConfigurationLinesFromGraph[config]

LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[%,"StandardNames"],{"Incidence",_}]

All

GraphData[{"Configuration",{{10,3},5}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"Configuration",{{10,3},5}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},5}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

linesets={
{{1,5,9},{1,3,7},{4,8,10},{2,5,10},{3,4,6},{3,8,9},{2,4,7},{5,7,8},{1,2,6},{6,9,10}},
{{1,5,6},{2,4,6},{3,4,7},{5,7,8},{1,3,9},{2,8,9},{3,5,10},{4,8,10},{6,9,10},{1,2,7,11},{3,8,11},{4,5,11}},
{{1,3,6},{2,4,6},{1,2,7},{3,4,7},{5,6,8},{2,8,9},{3,5,9},{1,5,10},{7,9,10},{4,8,10,12},{1,4,11},{2,3,11},{2,5,12},{7,11,12}},
{{3,4,5},{1,4,6},{2,5,6},{1,2,8},{3,7,8,11,12},{1,3,9},{6,7,9},{2,4,10},{5,7,10},{8,9,10,13},{1,3,11},{2,4,11},{1,7,12},{2,4,12},{3,6,12},{2,3,13},{5,7,13},{6,11,13}},
{{1,2,6},{3,4,6},{1,3,7},{2,5,7},{5,6,8},{1,8,9},{4,5,9},{2,4,10},{3,8,10},{7,9,10},{1,5,11},{2,3,11},{4,8,11}},
{{2,3,6},{4,5,6},{2,4,7},{3,5,7},{1,6,8},{1,3,9},{4,8,9},{1,2,10},{5,9,10},{7,8,10},{1,6,11},{2,4,11},{1,3,12},{2,5,12},{3,5,13},{4,8,13},{4,9,13},{11,12,13}},
{{1,3,5},{1,2,6},{3,4,6},{1,4,8},{6,7,8},{2,7,9},{4,5,9},{2,3,10},{5,7,10},{8,9,10},{1,4,11},{2,3,11},{2,3,12},{4,5,12},{1,4,13},{2,5,13},{7,12,13},{2,4,14},{5,11,14},{6,7,14}},
{{2,3,5},{1,5,6},{2,4,6},{1,2,8},{4,7,8},{1,3,9},{6,7,9},{3,4,10},{5,7,10},{8,9,10},{1,2,11},{3,4,11},{1,3,12},{4,5,12},{7,11,12},{1,4,13},{2,3,13},{6,7,13}},
{{1,3,5},{1,2,6},{3,4,6},{1,4,8},{5,7,8},{2,7,9},{4,5,9},{2,3,10},{6,7,10},{8,9,10},{1,4,11},{2,3,11},{1,7,12},{2,3,12},{4,5,12},{2,4,13},{5,7,13},{6,11,13}}
};

gr

points=Cases[gr,Inset[_,v_]:>pts,∞]

Length[points]

lines=Select[DeleteCases[linesets[[4]],_Integer?(GreaterThan[10]),∞],Length[#]==3&]

Length[lines]

LeviGraph[lines]//RecognizeGraph

cg[{10,3},3]=ConfigurationGraph[points,lines,VertexLabels->Automatic]

Degenerate

GraphData[{"Configuration",{{10,3},5}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},5}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},5}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},5}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},5}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},5}}],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},5}}],#]&/@hc

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

Planar

GraphData[{"Configuration",{{10,3},5}},"Planar"]

GraphData[{"Configuration",{{10,3},5}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{10,3},5}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},5}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},5}}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},5}}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},5}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},5}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

GraphPlot@

RegionIntersection[Line[pts[[{1,8}]]],Line[pts[[{6,9}]]]]//FullSimplify

pts=CirclePoints[{Csc[Pi/6]/2,-Pi/2},6];
pts=Join[pts,Subdivide[pts[[5]],pts[[3]],3][[2;;-2]]];
pts=Join[pts,{{pts[[8,1]],-1/2},{(1/(6 (Sqrt[3]))),-(1/2)}}];
g=Graph[Range[Length[pts]],UndirectedEdge@@@{e[7,1,2,3,4,5,6,1,10,8],e[6,7,4,8,2,9,8],e[5,7,8,3],{6,10},{1,9}},VertexCoordinates->pts,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},5}},"Circulant"]

GraphData[{"Configuration",{{10,3},5}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},5}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},5}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},5}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},5}}&]

RootGraph[GraphData[{"Configuration",{{10,3},5}}]]

Halin

GraphData[{"Configuration",{{10,3},5}},"Halin"]

GraphData[{"Configuration",{{10,3},5}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},5}},"Rigid"]

GraphData[{"Configuration",{{10,3},5}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},5}},"Flexible"]

GraphData[{"Configuration",{{10,3},5}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},5}},"LCF"]

GraphData[{"Configuration",{{10,3},5}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},5}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},5}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},5}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},5}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},5}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},5}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{10,3},5}},"VertexList"],GraphData[{"Configuration",{{10,3},5}},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},5}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},5}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},5}},"Matchstick"]

GraphData[{"Configuration",{{10,3},5}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},5}},"Edges"]]

3D All

GraphData[{"Configuration",{{10,3},5}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{10,3},5}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{10,3},5}},"Polyhedral"]

GraphData[{"Configuration",{{10,3},5}},"Graph",{"3D","Polyhedron"}]

{"Configuration", {{10, 3}, 6}}

Names

GraphData[{"Configuration",{{10,3},6}},"StandardName"]

GraphData[{"Configuration",{{10,3},6}},"StandardNames"]

Primary

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

Configuration

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

config=%[[1]]

ConfigurationDiagram[config,2,VertexLabels->None]

lines=ConfigurationLinesFromGraph[config]

r=LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[r,"StandardNames"],{"Incidence",_}]

All

GraphData[{"Configuration",{{10,3},6}},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},6}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{10,3},6}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},6}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},6}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},6}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},6}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},6}}],All][[All,All,1]]]

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

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

gs=bilat

Planar

GraphData[{"Configuration",{{10,3},6}},"Planar"]

GraphData[{"Configuration",{{10,3},6}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{10,3},6}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},6}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},6}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

GraphPlot@

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},6}},"Circulant"]

GraphData[{"Configuration",{{10,3},6}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},6}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},6}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},6}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},6}}&]

RootGraph[GraphData[{"Configuration",{{10,3},6}}]]

Halin

GraphData[{"Configuration",{{10,3},6}},"Halin"]

GraphData[{"Configuration",{{10,3},6}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},6}},"Rigid"]

GraphData[{"Configuration",{{10,3},6}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},6}},"Flexible"]

GraphData[{"Configuration",{{10,3},6}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},6}},"LCF"]

GraphData[{"Configuration",{{10,3},6}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},6}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},6}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},6}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},6}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},6}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},6}},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},6}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},6}},"Matchstick"]

GraphData[{"Configuration",{{10,3},6}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},6}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"Configuration",{{10,3},6}},"Polyhedral"]

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

{"Configuration", {{10, 3}, 7}}

Names

GraphData[{"Configuration",{{10,3},7}},"StandardName"]

GraphData[{"Configuration",{{10,3},7}},"StandardNames"]

Primary

GraphData[{"Configuration",{{10,3},7}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

config=GraphData[{"Configuration",{{10,3},7}},"Graph","Configuration"][[1]]//StyleGraphs

ConfigurationDiagram[config,2]

lines=ConfigurationLinesFromGraph[config]

r=LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[r,"StandardNames"],{"Incidence",_}]

All

GraphData[{"Configuration",{{10,3},7}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"Configuration",{{10,3},7}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},7}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{10,3},7}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},7}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},7}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},7}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},7}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},7}}],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},7}}],#]&/@hc

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

Planar

GraphData[{"Configuration",{{10,3},7}},"Planar"]

GraphData[{"Configuration",{{10,3},7}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{10,3},7}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},7}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},7}}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},7}}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},7}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},7}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

GraphPlot@

GraphPlot@

h=pts[[7,2]]-pts[[1,2]]//FullSimplify

(pts[[7]]-{0,# h})&/@{1,2}

pts=UnitCirclePoints[5];
pts=Join[pts,Subdivide[pts[[4]],pts[[2]],3][[2;;-2]]];
pts=Join[pts,(pts[[7]]-{0,# h/3})&/@{1,2},{pts[[6]]-{0,2h/3}}];
g=Graph[Range[Length[pts]],UndirectedEdge@@@{e[9,1,2,3,4,5,1,7,3,6,5,10,8,6,7,2],e[4,10,9,8,7,10]},VertexCoordinates->pts,VertexLabels->Automatic]

g=

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},7}},"Circulant"]

GraphData[{"Configuration",{{10,3},7}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},7}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},7}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},7}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},7}}&]

RootGraph[GraphData[{"Configuration",{{10,3},7}}]]

Halin

GraphData[{"Configuration",{{10,3},7}},"Halin"]

GraphData[{"Configuration",{{10,3},7}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},7}},"Rigid"]

GraphData[{"Configuration",{{10,3},7}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},7}},"Flexible"]

GraphData[{"Configuration",{{10,3},7}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},7}},"LCF"]

GraphData[{"Configuration",{{10,3},7}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},7}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},7}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},7}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},7}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},7}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},7}},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{10,3},7}},"VertexList"],GraphData[{"Configuration",{{10,3},7}},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},7}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},7}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},7}},"Matchstick"]

GraphData[{"Configuration",{{10,3},7}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},7}},"Edges"]]

3D All

GraphData[{"Configuration",{{10,3},7}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{10,3},7}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{10,3},7}},"Polyhedral"]

GraphData[{"Configuration",{{10,3},7}},"Graph",{"3D","Polyhedron"}]

{"Configuration", {{10, 3}, 8}}

Names

GraphData[{"Configuration",{{10,3},8}},"StandardName"]

GraphData[{"Configuration",{{10,3},8}},"StandardNames"]

Primary

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

Configuration

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

config=%[[1]]

ConfigurationDiagram[config,3]

lines=ConfigurationLinesFromGraph[config]

LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[%,"StandardNames"],{"Incidence",_}]

All

GraphData[{"Configuration",{{10,3},8}},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},8}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{10,3},8}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},8}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},8}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},8}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},8}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},8}}],All][[All,All,1]]]

gs=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},8}}],#]&/@hc

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

Planar

GraphData[{"Configuration",{{10,3},8}},"Planar"]

GraphData[{"Configuration",{{10,3},8}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{10,3},8}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},8}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},8}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

GraphPlot@

RegionIntersection[Line[pts[[{2,4}]]],InfiniteLine[pts[[{5,8}]]]]

pts=Join[CirclePoints[{1,-Pi/2},4]];
pts=Join[pts,Subdivide[pts[[1]],{0,0},3][[2;;-2]],{{(1/4),0},{3/16,-1/6},{3/8,-1/3},{-1/3,-1/3}}];
g=Graph[Range[Length[pts]],UndirectedEdge@@@{e[1,2,3,4,1,5,6,3],e[4,7,2,9,6,10,4,5,2],e[10,5,8,7,9],{6,8}},VertexCoordinates->pts,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},8}},"Circulant"]

GraphData[{"Configuration",{{10,3},8}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},8}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},8}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},8}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},8}}&]

RootGraph[GraphData[{"Configuration",{{10,3},8}}]]

Halin

GraphData[{"Configuration",{{10,3},8}},"Halin"]

GraphData[{"Configuration",{{10,3},8}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},8}},"Rigid"]

GraphData[{"Configuration",{{10,3},8}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},8}},"Flexible"]

GraphData[{"Configuration",{{10,3},8}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},8}},"LCF"]

GraphData[{"Configuration",{{10,3},8}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},8}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},8}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},8}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},8}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},8}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},8}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},8}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},8}},"Matchstick"]

GraphData[{"Configuration",{{10,3},8}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},8}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"Configuration",{{10,3},8}},"Polyhedral"]

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

{"Configuration", {{10, 3}, 9}}

Names

GraphData[{"Configuration",{{10,3},9}},"StandardName"]

GraphData[{"Configuration",{{10,3},9}},"StandardNames"]

Primary

GraphData[{"Configuration",{{10,3},9}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

GraphData[{"Configuration",{{10,3},9}},"Graph","Configuration"]//StyleGraphs

config=%[[1]]

ConfigurationDiagram[config,3]

lines=ConfigurationLinesFromGraph[config]

LeviGraph[lines]//RecognizeGraph

FirstCase[GraphData[%,"StandardNames"],{"Incidence",_}]

All

GraphData[{"Configuration",{{10,3},9}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"Configuration",{{10,3},9}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},9}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{10,3},9}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},9}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},9}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},9}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},9}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},9}}],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},9}}],#]&/@hc

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

Planar

GraphData[{"Configuration",{{10,3},9}},"Planar"]

GraphData[{"Configuration",{{10,3},9}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{10,3},9}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},9}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},9}}],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},9}}],TimeConstraint->10])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},9}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},9}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

GraphPlot@

RegionIntersection[Line[pts[[{1,8}]]],InfiniteLine[{pts[[4]],Mean[pts[[{7,8}]]]}]]//FullSimplify

pts=UnitCirclePoints[5];
pts=Join[pts,Subdivide[pts[[5]],Mean[pts[[{2,4}]]],4][[{2,3,-1}]]];
pts=Join[pts,{Mean[pts[[{1,2,8}]]],{(1/40) (5+(Sqrt[5])),-(1/4) (Sqrt[1-(2/(Sqrt[5]))])}}];
g=Graph[Range[Length[pts]],UndirectedEdge@@@{e[1,2,3,4,5,1,9,2,8,4,6,1,7],e[5,6,7,8,3],e[4,10,8,9],{1,10}},VertexCoordinates->pts,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},9}},"Circulant"]

GraphData[{"Configuration",{{10,3},9}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},9}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},9}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},9}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},9}}&]

RootGraph[GraphData[{"Configuration",{{10,3},9}}]]

Halin

GraphData[{"Configuration",{{10,3},9}},"Halin"]

GraphData[{"Configuration",{{10,3},9}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},9}},"Rigid"]

GraphData[{"Configuration",{{10,3},9}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},9}},"Flexible"]

GraphData[{"Configuration",{{10,3},9}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},9}},"LCF"]

GraphData[{"Configuration",{{10,3},9}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},9}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},9}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},9}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},9}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},9}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},9}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{10,3},9}},"VertexList"],GraphData[{"Configuration",{{10,3},9}},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},9}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},9}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},9}},"Matchstick"]

GraphData[{"Configuration",{{10,3},9}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},9}},"Edges"]]

3D All

GraphData[{"Configuration",{{10,3},9}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{10,3},9}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{10,3},9}},"Polyhedral"]

GraphData[{"Configuration",{{10,3},9}},"Graph",{"3D","Polyhedron"}]

{"Configuration", {{10, 3}, 10}}

Names

GraphData[{"Configuration",{{10,3},10}},"StandardName"]

GraphData[{"Configuration",{{10,3},10}},"StandardNames"]

Primary

GraphData[{"Configuration",{{10,3},10}}]//StyleGraphs[#,ImageSize->Small]&

Configuration

GraphData[{"Configuration",{{10,3},10}},"Graph",{"Labeled","Configuration"}]//StyleGraphs

lines=ConfigurationLinesFromGraph[GraphData[{"Configuration",{{10,3},10}},"Graph","Configuration"][[1]]]

LeviGraph[lines]//RecognizeGraph

All

GraphData[{"Configuration",{{10,3},10}},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{10,3},10}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{10,3},10}},"Edges"]

Norm@Mean[pts[[{2,4}]]]//FullSimplify//Quiet

N[%]

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

RecognizeGraph[g]

From Ed Pegg, Jr.
Mathematical Games, Episode 12: Configurations
Dec. 2023

Another configuration is based on a pentagon. We can solve for it.

pent=RootReduce[2CirclePoints[5]][[{1,3,5,2,4}]];NSolve[ResourceFunction["RealEuclideanDistance"][pent[[4]], a pent[[1]]+(1-a)pent[[2]]]+
ResourceFunction["RealEuclideanDistance"][a pent[[1]]+(1-a)pent[[2]], a pent[[5]]+(1-a)pent[[1]]]==
ResourceFunction["RealEuclideanDistance"][a pent[[5]]+(1-a)pent[[1]], pent[[4]]],100
]

Leading to this curious value:

val=x/.Solve[x ==(((x^3)+1)/((x^3)+2))][[2]]

points=Join[pent,RootReduce[val #[[1]] + (1-val)#[[2]]] &/@Partition[pent,2,1,1]]

lines=ResourceFunction["FindExtraordinaryLines"][points]

cg[{10,3},10]=ConfigurationGraph[points,lines,VertexLabels->Automatic]//Quiet

EdgeList[cg[{10,3},10]]

RecognizeGraph@cg[{10,3},10]

LeviGraph[lines]//RecognizeGraph

Degenerate

GraphData[{"Configuration",{{10,3},10}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Configuration",{{10,3},10}},"Graph","Degenerate"]

Perspective

GraphData[{"Configuration",{{10,3},10}},"Graph","Perspective"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{10,3},10}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{10,3},10}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"Configuration",{{10,3},10}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"Configuration",{{10,3},10}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Quiet//Timing

gs=bilat

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

quad

Planar

GraphData[{"Configuration",{{10,3},10}},"Planar"]

GraphData[{"Configuration",{{10,3},10}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{10,3},10}},{"RCN","CN"}]

GraphData[{"Configuration",{{10,3},10}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Configuration",{{10,3},10}}],TimeConstraint->1])//AbsoluteTiming

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

(g=MinimalCrossingGraph[GraphData[{"Configuration",{{10,3},10}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

GraphPlot@RotateGraph[,-2Pi/5]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{10,3},10}},"Circulant"]

GraphData[{"Configuration",{{10,3},10}},"Graph","Circulant"]//StyleGraphs

Complement graph

GraphData[{"Configuration",{{10,3},10}},"ComplementGraph","Name"]

Line graph

GraphData[{"Configuration",{{10,3},10}},"Line"]

LineGraphQ[GraphData[{"Configuration",{{10,3},10}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"Configuration",{{10,3},10}}&]

RootGraph[GraphData[{"Configuration",{{10,3},10}}]]

Halin

GraphData[{"Configuration",{{10,3},10}},"Halin"]

GraphData[{"Configuration",{{10,3},10}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Configuration",{{10,3},10}},"Rigid"]

GraphData[{"Configuration",{{10,3},10}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Configuration",{{10,3},10}},"Flexible"]

GraphData[{"Configuration",{{10,3},10}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Configuration",{{10,3},10}},"LCF"]

GraphData[{"Configuration",{{10,3},10}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{10,3},10}},"LCFSignature"]

GraphData[{"Configuration",{{10,3},10}},"LCFNotations"]

GraphData[{"Configuration",{{10,3},10}},"Graph","LCF"]//StyleGraphs

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

UnitDistance

GraphData[{"Configuration",{{10,3},10}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{10,3},10}}],Debug->True]//Timing

GraphData[{"Configuration",{{10,3},10}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{10,3},10}},"VertexList"],GraphData[{"Configuration",{{10,3},10}},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},10}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData[{"Configuration",{{10,3},10}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Configuration",{{10,3},10}},"Matchstick"]

GraphData[{"Configuration",{{10,3},10}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{10,3},10}},"Edges"]]

3D All

GraphData[{"Configuration",{{10,3},10}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Configuration",{{10,3},10}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Configuration",{{10,3},10}},"Polyhedral"]

GraphData[{"Configuration",{{10,3},10}},"Graph",{"3D","Polyhedron"}]

{"Configuration", {{12, 3}, 210}} == "NauruConfigurationGraph"

Names

GraphData[{"Configuration",{{12,3},210}},"StandardName"]

GraphData[{"Configuration",{{12,3},210}},"StandardNames"]

{"Configuration", {{17, 3}, 1}}

GraphData[{"Configuration",{{17,3},1}},"StandardName"]

{"Configuration",{{17,3},1}}

Primary

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

All

GraphData[{"Configuration",{{17,3},1}},"Graph","All"]//StyleGraphs

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"Configuration",{{17,3},1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Configuration",{{17,3},1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Configuration",{{17,3},1}},"Graph","Degenerate"]//StyleGraphs

Configuration

GraphData[{"Configuration",{{17,3},1}},"Graph","Configuration"]//StyleGraphs

Bilateral

GraphData[{"Configuration",{{17,3},1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Configuration",{{17,3},1}},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"Configuration",{{17,3},1}},"Planar"]

GraphData[{"Configuration",{{17,3},1}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"Configuration",{{17,3},1}},{"RCN","CN"}]

GraphData[{"Configuration",{{17,3},1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

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

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

Table[MinimalCrossingGraph[GraphData[{"Configuration",{{17,3},1}}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Configuration",{{17,3},1}},"Circulant"]

GraphData[{"Configuration",{{17,3},1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"Configuration",{{17,3},1}},"Halin"]

GraphData[{"Configuration",{{17,3},1}},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"Configuration",{{17,3},1}},"LCF"]

GraphData[{"Configuration",{{17,3},1}},"HamiltonianCycleCount"]

GraphData[{"Configuration",{{17,3},1}},"LCFSignature"]

GraphData[{"Configuration",{{17,3},1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"Configuration",{{17,3},1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Configuration",{{17,3},1}}],Debug->True]//Timing

GraphData[{"Configuration",{{17,3},1}},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Configuration",{{17,3},1}},"VertexList"],GraphData[{"Configuration",{{17,3},1}},"EdgeList"]]]

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

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData[{"Configuration",{{17,3},1}},"Matchstick"]

GraphData[{"Configuration",{{17,3},1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Configuration",{{17,3},1}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"Configuration",{{17,3},1}},"Polyhedral"]

GraphData[{"Configuration",{{17,3},1}},"Graph",{"3D","Polyhedron"}]

"CoxeterConfigurationGraph"

Names

GraphData["CoxeterConfigurationGraph","StandardName"]

GraphData["CoxeterConfigurationGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["CoxeterConfigurationGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Configuration

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

Bilateral

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

Circular

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

Planar

GraphData["CoxeterConfigurationGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["CoxeterConfigurationGraph","Circulant"]

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

Halin

GraphData["CoxeterConfigurationGraph","Halin"]

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

LCF

GraphData["CoxeterConfigurationGraph","LCF"]

GraphData["CoxeterConfigurationGraph","HamiltonianCycleCount"]

GraphData["CoxeterConfigurationGraph","LCFSignature"]

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

UnitDistance

GraphData["CoxeterConfigurationGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["CoxeterConfigurationGraph","Matchstick"]

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

3D default

Graph3D[GraphData["CoxeterConfigurationGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["CoxeterConfigurationGraph","Polyhedral"]

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

"CremonaRichmondConfigurationGraph"

GraphData["CremonaRichmondConfigurationGraph","StandardName"]

GraphData["CremonaRichmondConfigurationGraph","V"]

Primary

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

All

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

Inexact

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

Exact construction

Boben, M.; Grünbaum, B.; Pisanski, T.; and Zitnik.  "Small Triangle-Free Configurations of Points and Lines."  Disc. Comput. Geom. 35, 405–427, 2006.

https://link.springer.com/content/pdf/10.1007/s00454-005-1224-9.pdf?pdf=button

Find points like v14 and v13  by,  in the right figure, setting v11 = (x, y) and making line((x, y), v6) intersect line(v9, v2) in the point (Subscript[R, 2Pi/5]).(x, y) with (Subscript[R, θ]) the rotation matrix

LineLineIntersection[{{x1_,y1_},{x2_,y2_}},{{x3_,y3_},{x4_,y4_}}]:=Module[{x,y},
{x,y}/.Solve[{
Det[{{x,y,1},{x1,y1,1},{x2,y2,1}}]==0,
Det[{{x,y,1},{x3,y3,1},{x4,y4,1}}]==0
},{x,y}]][[1]
]

LineLineIntersection[{{0,0},{1,1}},{{1,0},{0,1}}]

pts=UnitCirclePoints[5];
pts=RootReduce@Join[pts,pts[[#2]]+(pts[[#2]]-pts[[#1]])&@@@{{5,3},{1,4},{2,5},{3,1},{4,2}}];
g=Graph[Range[Length[pts]],UndirectedEdge@@@{},VertexCoordinates->pts,VertexLabels->Automatic]

eqn=LineLineIntersection[{{x,y},pts[[6]]},pts[[{2,9}]]]-RotationMatrix[2Pi/5].{x,y}

{x,y}/.NSolve[eqn,{x,y},WorkingPrecision->50]

solns={x,y}/.Solve[Thread[eqn==0],{x,y}]

N[solns,20]

pt=ToAlgebraicRoot/@solns[[2]]

pt={(NumericalApproximation[Root, (RowDefault["2.27", FEExpressionsNumericalApproximationElider]), Root[-261+1338 #1-1120 ((#1)^2)-144 ((#1)^3)+176 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.0420", FEExpressionsNumericalApproximationElider]), Root[81-47340 ((#1)^2)+769760 ((#1)^4)-2579200 ((#1)^6)+774400 ((#1)^8)&,5], ])};

pts=UnitCirclePoints[5];
pts=RootReduce@Join[pts,pts[[#2]]+(pts[[#2]]-pts[[#1]])&@@@{{5,3},{1,4},{2,5},{3,1},{4,2}}];
pts=Join[pts,RootReduce@Table[RotationMatrix[2Pi i/5].pt,{i,0,4}]];
g=Graph[Range[Length[pts]],UndirectedEdge@@@{e[1,3,5,2,4,1,9,15,14,4,6,12,11,1,8,14,13,3,10,11,15,5,7,13,12,2,9],{2,10},{3,6},{4,7},{5,8}},VertexCoordinates->pts,VertexLabels->Automatic]

RegionDistance[Line[pts[[{14,9}]]],pts[[15]]]//RootReduce

RecognizeGraph@g

Embedding types

GraphDataEmbeddings[GraphData["CremonaRichmondConfigurationGraph","EdgeList"]]

Default embedding

g=RotateGraph[Graph[GraphData["CremonaRichmondConfigurationGraph","Edges"]],{5,6}]

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

RecognizeGraph[g]

Degenerate

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

Configuration

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

Bilateral

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

Circular

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

Planar

GraphData["CremonaRichmondConfigurationGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["CremonaRichmondConfigurationGraph","Circulant"]

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

Halin

GraphData["CremonaRichmondConfigurationGraph","Halin"]

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

LCF

GraphData["CremonaRichmondConfigurationGraph","LCF"]

GraphData["CremonaRichmondConfigurationGraph","HamiltonianCycleCount"]

GraphData["CremonaRichmondConfigurationGraph","LCFSignature"]

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

UnitDistance

GraphData["CremonaRichmondConfigurationGraph","UnitDistance"]

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData["CremonaRichmondConfigurationGraph","Matchstick"]

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

3D default

Graph3D[GraphData["CremonaRichmondConfigurationGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["CremonaRichmondConfigurationGraph","Polyhedral"]

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

"DanzerConfigurationGraph"

"DesarguesConfigurationGraph" == {"BlackBishop", {4, 5}}

GraphData["DesarguesConfigurationGraph","StandardName"]

Configuration

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

"GruenbaumRigbyConfigurationGraph"

GraphData["GruenbaumRigbyConfigurationGraph","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["GruenbaumRigbyConfigurationGraph","EdgeList"]]

Default embedding

gs=Graph[GraphData["GruenbaumRigbyConfigurationGraph","Edges"],GraphLayout->#]&/@{"SpringEmbedding","HighDimensionalEmbedding"}

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

RecognizeGraph[g]

Degenerate

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

Configuration

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

Bilateral

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

Circular

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

Planar

GraphData["GruenbaumRigbyConfigurationGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["GruenbaumRigbyConfigurationGraph","Circulant"]

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

Halin

GraphData["GruenbaumRigbyConfigurationGraph","Halin"]

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

LCF

GraphData["GruenbaumRigbyConfigurationGraph","LCF"]

GraphData["GruenbaumRigbyConfigurationGraph","HamiltonianCycleCount"]

GraphData["GruenbaumRigbyConfigurationGraph","LCFSignature"]

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

UnitDistance

GraphData["GruenbaumRigbyConfigurationGraph","UnitDistance"]

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData["GruenbaumRigbyConfigurationGraph","Matchstick"]

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

3D default

Graph3D[GraphData["GruenbaumRigbyConfigurationGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["GruenbaumRigbyConfigurationGraph","Polyhedral"]

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

"NauruConfigurationGraph"

"PappusConfigurationGraph"

GraphData["PappusConfigurationGraph","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["PappusConfigurationGraph","EdgeList"]]

Default embedding

GraphPlot[GraphData["PappusConfigurationGraph","Edges"],GraphLayout->"SpringEmbedding"]

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

RecognizeGraph[g]

GraphData["GoddardHenningGraph","Graph",4]

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

RecognizeGraph@g

RotateGraph[Graph[GraphData["PappusConfigurationGraph","Edges"],GraphLayout->"HighDimensionalEmbedding"],-3Pi/8]

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

RecognizeGraph@g

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["PappusConfigurationGraph","Planar"]

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

Tutte embeddings

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

Tally[ReverseSort[Length/@faces]]

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

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

RecognizeGraph/@gs

Tutte embedding construction 4 #1

g=EdgeAdd[GraphData["GoddardHenningGraph","Graph",{"Labeled","Planar"}][[1]],{4\[UndirectedEdge]9,9\[UndirectedEdge]2}]

RecognizeGraph[g]

Tutte embedding construction 4 #2

GraphPlot[RotateGraph[,-3Pi/4]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Circulant

GraphData["PappusConfigurationGraph","Circulant"]

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

Halin

GraphData["PappusConfigurationGraph","Halin"]

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

LCF

GraphData["PappusConfigurationGraph","LCF"]

GraphData["PappusConfigurationGraph","HamiltonianCycleCount"]

GraphData["PappusConfigurationGraph","LCFSignature"]

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

UnitDistance

GraphData["PappusConfigurationGraph","UnitDistance"]

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData["PappusConfigurationGraph","Matchstick"]

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

3D default

Graph3D[GraphData["PappusConfigurationGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["PappusConfigurationGraph","Polyhedral"]

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

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

3D Canonical

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

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

3D Canonical construction

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

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->1000,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

pts=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@pts[[#]]],Line[pts[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

"PaschConfigurationGraph" == "CisSquareWithTwoTriangles"

GraphData["PaschConfigurationGraph","StandardName"]

Configuration

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

"ReyeConfigurationGraph"

GraphData["ReyeConfigurationGraph","StandardName"]

Primary

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

GraphData["ReyeConfigurationGraph","Graph","3D"]//StyleGraphs[#,ImageSize->Small]&

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ReyeConfigurationGraph","EdgeList"]]

Default embedding

GraphPlot[GraphData["ReyeConfigurationGraph","Edges"],GraphLayout->"HighDimensionalEmbedding"]

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

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["ReyeConfigurationGraph","Planar"]

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

Circulant

GraphData["ReyeConfigurationGraph","Circulant"]

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

Halin

GraphData["ReyeConfigurationGraph","Halin"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

GraphPlot@RotateGraph[,Pi/2]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

EdgeCount[g]

LCF

GraphData["ReyeConfigurationGraph","LCF"]

GraphData["ReyeConfigurationGraph","HamiltonianCycleCount"]

GraphData["ReyeConfigurationGraph","LCFSignature"]

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

UnitDistance

GraphData["ReyeConfigurationGraph","UnitDistance"]

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData["ReyeConfigurationGraph","Matchstick"]

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

3D default

Graph3D[GraphData["ReyeConfigurationGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["ReyeConfigurationGraph","Polyhedral"]

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

"SchlaefliDoubleSixConfigurationGraph"

GraphData

GraphData["CisSquareWithTwoTriangles","Graph","Configuration"]

GraphData["CisSquareWithTwoTriangles","Graph","Configuration"][[1]]//GraphEmbedding

ResourceFunction["FindExtraordinaryLines"][%]

AddAllConfigurationEdges[GraphData["CisSquareWithTwoTriangles","Graph","Configuration"][[1]]]

GraphDataString

<<MathWorld`Graphs`

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

WriteString[file,GraphDataString[
#2,
"StandardName"->{"Configuration",{{10,3},#}},
"Name"->"(10,3)\[Hyphen]configuration graph "<>ToString[#],
"EmbeddingClasses"->{"Configuration"},
"Information"->"Configuration",
"Skip"->{"ConstructionNumber","EdgeCuts","HadwigerNumber","MinimalEdgeCovers","Minors","QuadraticEmbeddingConstant"}
]]&@@@Delete[data,{{1},{4}}];

Close[file]