Desargues Graph

Author

Eric W. Weisstein
December 13, 2023

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

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

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

Additional Authors

Some embeddings from Ed Pegg
August 30, 2002 and March 1, 2007

Configuration

GraphData["DesarguesGraph","Incidence"]

lines=GraphData["DesarguesGraph","Configurations"]

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

RecognizeGraph[LeviGraph[#]]&/@lines

GraphData["DesarguesConfigurationGraph","#"]

configg=GraphData["DesarguesConfigurationGraph","Graph",{"Configuration","Labeled"}][[1]]

lines2=ConfigurationLinesFromGraph[configg]

LeviGraph[lines2]//RecognizeGraph

points=GraphEmbedding[configg]

ResourceFunction["FindExtraordinaryLines"][points]

ConfigurationGraph[points,lines2,VertexLabels->Automatic]

RecognizeGraph@%

ConfigurationDiagram[points,lines2]

Embeddings

Names

GraphData["DesarguesGraph","StandardName"]

GraphData["DesarguesGraph","StandardNames"]

Primary

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

distanceregular.org construction

g=DistanceRegularGraph["http://www.distanceregular.org/graphdata/desargues.am"]

ToEntity[g]

VertexCount[g]

GraphDiameter[g]//Timing

RegularParameters[g]//Timing

DistanceRegularGraphQ[g]//Timing

GraphData[RecognizeGraph[g],"DistanceTransitive"]

IntersectionArray[g]//Timing

IntegerSpectrum[g]//SpectrumForm

GroupOrder[GraphAutomorphismGroup[g]]

HamiltonianGraphQ[g]

Read and Wilson construction

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["DesarguesGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

IGraph

GraphData["DesarguesGraph","NotationRules","IGraph"]

Cases[GraphData["DesarguesGraph","StandardNames"],{"IGraph",_}]

Cases[GraphData["DesarguesGraph","StandardNames"],{"IGraph",i_}:>IGraph@@i]//StyleGraphs

GraphData["DesarguesGraph","Graph","IGraph"]//StyleGraphs

MiddleLayer

GraphData[{"MiddleLayer",2},"MiddleLayer"]

GraphData[{"MiddleLayer",2},"NotationRules","MiddleLayer"]

g=MiddleLayerGraph[2]

RecognizeGraph@g

UnitDistanceGraphEmbeddingQ[g]

GeneralizedPetersen

GraphData["DesarguesGraph","GeneralizedPetersen"]

GraphData["DesarguesGraph","NotationRules","GeneralizedPetersen"]

GraphData["DesarguesGraph","Graph","GeneralizedPetersen"]//StyleGraphs

PetersenGraph[10,3]

RecognizeGraph[%]

Planar

GraphData["DesarguesGraph","Planar"]

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

Integral

GraphData["DesarguesGraph","Graph","Integral"]//StyleGraphs

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

GraphPlot@RotateGraph[,Pi/6]

GraphPlot@RotateGraph[,2Pi/6]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["DesarguesGraph","Circulant"]

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

Line graph

GraphData["DesarguesGraph","Line"]

LineGraphQ[GraphData["DesarguesGraph"]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== "DesarguesGraph"&]

RootGraph[GraphData["DesarguesGraph"]]

Halin

GraphData["DesarguesGraph","Halin"]

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

Rigid

GraphData["DesarguesGraph","Rigid"]

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

Flexible

GraphData["DesarguesGraph","Flexible"]

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

LCF

GraphData["DesarguesGraph","LCF"]

GraphData["DesarguesGraph","HamiltonianCycleCount"]

GraphData["DesarguesGraph","LCFSignature"]

GraphData["DesarguesGraph","LCFNotations"]

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

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

LCF compute all

Length[FindHamiltonianCycle[GraphData["DesarguesGraph"],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData["DesarguesGraph"],All])[[All,2]]]//Timing

lcf

LCFGraph@@@lcf//StyleGraphs

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

Length[gs]

UnitDistance

GraphData["DesarguesGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["DesarguesGraph","VertexList"],GraphData["DesarguesGraph","EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance construction Gerbracht

From E. H.-A. Gerbracht
Jan. 1, 2010

rA=Sin[1/2*(Pi-2*k/n*Pi)]/Sin[k*2*Pi/n]/.{n->10,k->3};
rB=Sin[1/2*(Pi-2*k/n*Pi)]/Sin[k*2*Pi/n]/.{n->10,k->1};

v={{rA*Cos[0],rA*Sin[0*2*Pi/10]},
{rA*Cos[2*Pi/10],rA*Sin[1*2*Pi/10]},
{rA*Cos[2*2*Pi/10],rA*Sin[2*2*Pi/10]},
{rA*Cos[3*2*Pi/10],rA*Sin[3*2*Pi/10]},
{rA*Cos[4*2*Pi/10],rA*Sin[4*2*Pi/10]},
{rA*Cos[5*2*Pi/10],rA*Sin[5*2*Pi/10]},
{rA*Cos[6*2*Pi/10],rA*Sin[6*2*Pi/10]},
{rA*Cos[7*2*Pi/10],rA*Sin[7*2*Pi/10]},
{rA*Cos[8*2*Pi/10],rA*Sin[8*2*Pi/10]},
{rA*Cos[9*2*Pi/10],rA*Sin[9*2*Pi/10]},
{rB*Cos[0],rB*Sin[0]},
{rB*Cos[2*Pi/10],rB*Sin[2*Pi/10]},
{rB*Cos[2*2*Pi/10],rB*Sin[2*2*Pi/10]},
{rB*Cos[3*2*Pi/10],rB*Sin[3*2*Pi/10]},
{rB*Cos[4*2*Pi/10],rB*Sin[4*2*Pi/10]},
{rB*Cos[5*2*Pi/10],rB*Sin[5*2*Pi/10]},
{rB*Cos[6*2*Pi/10],rB*Sin[6*2*Pi/10]},
{rB*Cos[7*2*Pi/10],rB*Sin[7*2*Pi/10]},
{rB*Cos[8*2*Pi/10],rB*Sin[8*2*Pi/10]},
{rB*Cos[9*2*Pi/10],rB*Sin[9*2*Pi/10]}};

ShowLabeledGraph[g=Graph[List/@Join[{},
Partition[Range[11,20],2,1,1],
{#,#+10}&/@Range[10],
Table[Mod[{i,i+3}-1,10]+1,{i,10}]
],List/@v]]

RecognizeGraph[g]

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

gs={,,RotateGraph[,{47,121}],,,,,,,,}

Matchstick

GraphData["DesarguesGraph","Matchstick"]

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

3D default

Graph3D[GraphData["DesarguesGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["DesarguesGraph","Polyhedral"]