Grünbaum-Rigby Configuration

Author

Eric W. Weisstein
December 15, 2022

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Combinatorics/Grunbaum-RigbyConfiguration.nb.

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

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

Source

https://en.wikipedia.org/wiki/Gr%C3%BCnbaum%E2%80%93Rigby_configuration

Configuration

Points and lines from Ed Pegg, Jr.
Dec 15, 2022

v=RootReduce[Flatten[Transpose[{CirclePoints[7],RotateRight[(NumericalApproximation[Root, (RowDefault["-2.80", FEExpressionsNumericalApproximationElider]), Root[-1+3 #1+4 ((#1)^2)+((#1)^3)&,1], ])CirclePoints[7],4],(NumericalApproximation[Root, (RowDefault["4.05", FEExpressionsNumericalApproximationElider]), Root[-1-4 #1-3 ((#1)^2)+((#1)^3)&,3], ])CirclePoints[7]}],1]]

Lines from
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,7,11},{2,3,18,20},{3,4,7,12},{4,5,10,14},{2,5,6,21},
{6,7,10,15},{7,8,13,17},{3,5,8,9},{9,10,13,18},{10,11,16,20},
{6,8,11,12},{12,13,16,21},{2,13,14,19},{9,11,14,15},
{3,15,16,19},{1,5,16,17},{12,14,17,18},{1,6,18,19},{4,8,19,20},{15,17,20,21},{1,4,9,21}};

ConfigurationDiagram[points,lines,.4,VertexLabels->None]

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

cgname=RecognizeGraph[cg]

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

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

g=LeviGraph[lines]

RecognizeGraph@g

LCF embedding from Ed Pegg, Jr.
Dec 15, 2022

vertices=Sort[Thread[Flatten[Transpose[{Range[21],Range[21]+21}]]->RotateLeft[CirclePoints[42],1]]][[All,2]];

edges=Sort[UndirectedEdge@@@Flatten[Table[{#,k+21}&/@lines[[k]],{k,21}],1]];

g2=Graph[Range[Length[vertices]],edges,VertexCoordinates->vertices]

g2=;

LCFNotation@g2

IsomorphicGraphQ[g1,g2]

Orchard-Planting problem for 22 points with 4 points on each line

OrderedPointsOnLineSegment

Ed Pegg, Jr.
Dec 11, 2023

points=Append[RootReduce[Flatten[#  CirclePoints[7]&/@{Root[1-4 #+3 #^2+#^3&,2,0],-1,Root[1+3 #-4 #^2+#^3&,2,0]},1]],{0,0}];
lines=ResourceFunction["FindExtraordinaryLines"][points];

OrderedPointsOnlines[[1]]

<<MathWorld`Graphs`

?Line

Graphics[{LongestLine[points,#]&/@lines,Disk[#,.05]&/@points}]

ConfigurationGraph[points,lines]

RecognizeGraph@%

Length[lines]

Length[points]

LeviGraph[lines]

RecognizeGraph@%