Perkel Graph

Author

Eric W. Weisstein
October 21, 2022

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

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

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

Embeddings

GraphData["PerkelGraph","StandardName"]

Primary

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

All

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

Default embedding

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

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData["PerkelGraph","EdgeList"]]

Degenerate

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

Circular

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

Planar

GraphData["PerkelGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

CrossingNumber[GraphData["PerkelGraph"],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData["PerkelGraph"],"CrossingNumber"->cn]]

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["PerkelGraph","Circulant"]

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

Halin

GraphData["PerkelGraph","Halin"]

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

LCF

GraphData["PerkelGraph","LCF"]

GraphData["PerkelGraph","LCFSignature"]

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

LCFFromEmbedding/@%

LCF compute

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

Tally[(lcf=LCF[GraphData["PerkelGraph"],All])[[All,2]]]

gs=LCFGraph@@@DeleteCases[lcf,{_,1|2}]

UnitDistance

GraphData["PerkelGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine/@GraphData["PerkelGraph","Graph","All"]

Select[%,UnitDistanceGraphEmbeddingQ]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

FindUnitDistanceEmbedding[GraphData["PerkelGraph"],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["PerkelGraph","Matchstick"]

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

3D default

Graph3D[GraphData["PerkelGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["PerkelGraph","Polyhedral"]

GraphData["PerkelGraph","Graph",{"3D","Polyhedron"}]

Construction

Mod

PerkelGraph =Graph[UndirectedEdge@@@Flatten[Table[{
{Mod[a,19,1],Mod[a+2,19,1]+19},
{Mod[a,19,1],Mod[a+5,19,1]+19},
{Mod[a,19,1],Mod[a+7,19,1]+19},
{Mod[a,19,1],Mod[a+5,19,1]+38},
{Mod[a,19,1],Mod[a-4,19,1]+38},
{Mod[a,19,1],Mod[a-8,19,1]+38},
{Mod[a,19,1]+19,Mod[a+7,19,1]+38},
{Mod[a,19,1]+19,Mod[a-4,19,1]+38},
{Mod[a,19,1]+19,Mod[a-5,19,1]+38}},{a,1,19}],1]]

Ed's Construction

2008-09-30

perkel57 =Select[Select[Tuples[Flatten[Table[{a,b},{a,0,2},{b,0,18}],1],{2}],MemberQ[{{0,1},{1,2},{2,0}},First[Transpose[#]]]&],Mod[(#[[2,2]]-#[[1,2]])^3,19] == Mod[2^(6 #[[1,1]]),19]&];

graph=Graph[UndirectedEdge@@@Map[19#[[1]]+#[[2]]&,perkel57,{2}]]

RecognizeGraph[graph]

distanceregular.org

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

RecognizeGraph[g]

VertexCount[g]

GraphDiameter[g]//Timing

RegularParameters[g]//Timing

DistanceRegularGraphQ[g]//Timing

IntersectionArray[g]//Timing

IntegerSpectrum[g]//SpectrumForm

GroupOrder[GraphAutomorphismGroup[g]]

HamiltonianGraphQ[g]

GraphData

GraphClasses

GraphClassString["PerkelGraph"]

GraphDataString

GraphDataString[PerkelGraph,
"Name"->"PerkelGraph",
"StandardName"->"PerkelGraph",
"Information"->"PerkelGraph",
"Skip"->{"Perfect"},
TimeConstraint->60,
Debug->True
]