Petersen Graph

Author

Eric W. Weisstein
November 10, 2022

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

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

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

Embeddings

GraphData["PetersenGraph","StandardName"]

Construction from Read and Wilson

p. 276: Snarks: 10-20 vertices

Read and Wilson

Primary

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

All

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

Exact constructions

Various embeddings by Ed Pegg, Jr.
February 4, 2003, February 27, 2007, March 2007

Select[GraphData["PetersenGraph","Graph","All"]//StyleGraphs,!FreeQ[GraphEmbedding@#,_?InexactNumberQ]&]

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

RecognizeGraph[g]

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

RecognizeGraph[g]

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

RecognizeGraph[g]

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

RecognizeGraph[g]

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

RecognizeGraph[g]

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

RecognizeGraph[g]

dx=v[[7,1]]-v[[8,1]]//FullSimplify

Mean[v[[{7,8,9,10}]]]//FullSimplify

Mean[v[[{7,8,9,10}]]]//FullSimplify

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData["PetersenGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["PetersenGraph","Planar"]

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

MinimalCrossing

GraphData["PetersenGraph","CrossingNumber"]

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

MinimalRectilinearCrossing

GraphData["PetersenGraph","RectilinearCrossingNumber"]

GraphData["PetersenGraph","Graph","MinimalRectilinearCrossing"]//StyleGraphs

RectilinearCrossingCount/@%

MinimalCrossing construction

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

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GeneralizedPetersen

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

IGraph

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

Circulant

GraphData["PetersenGraph","Circulant"]

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

Halin

GraphData["PetersenGraph","Halin"]

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

LCF

GraphData["PetersenGraph","LCF"]

GraphData["PetersenGraph","LCFSignature"]

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

UnitDistance

GraphData["PetersenGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["PetersenGraph","VertexList"],GraphData["PetersenGraph","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

Matchstick

GraphData["PetersenGraph","Matchstick"]

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

3D default

Graph3D[GraphData["PetersenGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["PetersenGraph","Polyhedral"]

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

Properties table

Table

TextGrid[GraphDataTable["PetersenGraph",x],Dividers->All]

Properties

CrossingNumber

GraphData["PetersenGraph","CrossingNumber"]

Dear Eric Weisstein,

we have successfully computed the crossing number of your graph (Petersen graph).
The graph has a crossing number of 2.

Please visit this link for detailed results: http://crossings.uos.de/job/2bgP4lf_NMf2wj3lCLDmeg

Construction

MinimalRectilinearCrossing (Exoo)

Exoo

Show[img=ImageCrop[Import["http://isu.indstate.edu/ge/COMBIN/RECTILINEAR//pete.gif"]],ImageSize->Small]

Length[pts=ImageValuePositions[img,Red,.1]]

Graphics[Point[pts],ImageSize->Small]

Length[v=Mean/@FindClusters[pts,Method->"NeighborhoodContraction"]]

Graphics[Point[v],ImageSize->Small]

v=v/Max[Abs[v]];

g=System`Graph[Range[Length[v]],Sort/@UndirectedEdge@@@Join@@(Partition[#,2,1]&/@{
{4,1,5,10,9,4},{4,2,3,5},{9,8,6,7,10},{7,2},{3,8},{1,6}
}),VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

RectilinearCrossingNumber@g

l={{gn="PetersenGraph",{0,If[Max[Abs[Flatten[#]]]>10,#/Max[Abs[Flatten[#]]],#]&/@Append[GraphData[gn,"Embeddings"],ToCommonEdges[g,GraphData[gn]]]}}}

PropertyReplace[l,"Embeddings","11.3"]

RenameGraphFiles[]

l={{gn="PetersenGraph",{0,Append[GraphData[gn,"EmbeddingClasses"],{"MinimalCrossing","MinimalRectilinearCrossing"}]}}}

PropertyReplace[l,"EmbeddingClasses","11.3"]

RenameGraphFiles[]

UnitDistance

(g=With[{p=5,q=2},Graph[List/@{{1,2},{2,3},{3,4},{4,5},{1,5},Sequence@@Partition[Range[6,10],2,1,1],{1,6},{4,7},{2,8},{5,9},{3,10}},List/@Join[((Sin[(((p-2q))/(2p))π])/(Sin[2(q/p)π]))Through[{Cos,Sin}[π/2+4π #/5]]&/@Range[0,4],Csc[π/5]/2Through[{Cos,Sin}[π+2π #/5]]&/@Range[0,4]]]])//ShowLabeledGraph

RecognizeGraph[g]

Norm/@Subtract@@@(Edges[g]/.Thread[Range[10]->N[Vertices[g]]])

RootReduce[Norm/@Subtract@@@(Edges[g]/.Thread[Range[10]->Vertices[g]])]

ReplacePart[GraphData["PetersenGraph","Embeddings"],9->N@ToCommonEdges[g,Graph["PetersenGraph"]]]

GetGraphData["PetersenGraph","File"]

Modular difference (using Combinatorica)

PetersenGraphConstruction:=Module[{p=GraphUnion[MakeUndirected@MakeGraph[Range[5],Mod[#1-#2,5]==2&],Cycle[5]]},AddEdges[p,{#,#+5}&/@Range[5]]]

distanceregular.org

g=DistanceRegularGraph["http://www.distanceregular.org/graphdata/petersen.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]

Moebius Embedding

PetersenMoebius = Graph[{{{1,5}},{{2,4}},{{3,7}},{{4,5}},{{4,6}},{{5,8}},{{6,7}},{{6,9}},{{7,10}},{{8,9}},{{8,11}},{{9,12}},{{10,12}},{{10,16}},{{11,13}},{{11,14}},{{12,13}},{{13,15}}},{{{605.063,-845.688}},{{605.063,-624}},{{605.063,-402.313}},{{775.688,-697.875}},{{861,-845.688}},{{861,-550.125}},{{946.313,-402.313}},{{1031.56,-845.688}},{{1031.56,-648.625}},{{1116.88,-402.313}},{{1202.19,-845.688}},{{1202.19,-550.125}},{{1287.5,-697.875}},{{1458.13,-845.688}},{{1458.13,-624}},{{1458.13,-402.313}}}];

ShowLabeledGraph[PetersenMoebius, VertexStyle->Disk[.03],VertexColor->Red, AspectRatio->Automatic]

M/@{Graph["PetersenGraph"],PetersenMoebius}

Degrees[PetersenMoebius]

s=Position[Degrees[PetersenMoebius],1]//Flatten

s2=Subsets[s,{2}]

Select[Subsets[s2,{3}],RecognizeGraph[AddEdges[PetersenMoebius,#]]==="PetersenGraph"&]

Knuth

V4f0
Problem 43

ShowLabeledGraph[g1=AddEdges[AddVertices[DeleteVertex[Graph[{"Grid",{3,3}}],5],{{3/2,5/2},{5/2,5/2}}],{{6,9},{9,3},{1,10},{10,8},{7,2},{4,5},{9,10}}]]

r=RecognizeGraph[g1]

Insert[GraphData[r,"Embeddings"],ToCommonEdges[g1,Graph[r]],8]

GetGraphData["PetersenGraph","File"]

ShowLabeledGraph[g2=AddEdges[AddVertices[Graph[{"Cycle",6}],Append[PolygonPoints[3,1/2],{0,0}]],{{6,10},{10,4},{10,2},{8,9},{9,7},{8,7},{5,8},{3,7},{1,9}}]]

r=RecognizeGraph[g2]

GraphData[{"Cubic",{10,11}},"AllImages"]

GraphData[r,"Embeddings"]

ToCommonEdges[g2,Graph[r]]

Insert[GraphData[r,"Embeddings"],ToCommonEdges[g2,Graph[r]],1]

GetGraphData[{"Cubic",{10,11}},"File"]

Derived Graphs

Show[GraphData[#,"Image"],PlotLabel->Style[GraphData[#,"Name"],Italic,FontFamily->"Times"]]&/@Complement[GraphData["Petersen*"],{"PetersenGraph"}]

LineGraph

Line graph (Brouwer et al., p. 375)

System`LineGraph[GraphData["PetersenGraph"]]//ToEntity//CanonicalName

GraphicsGrid[Partition[GraphData["Qt39","AllImages"],5,5,{1,1},{}],ImageSize->500]

TetrahedronReplacedPetersenLineGraph

“HamiltonDecomposable” = False

“HamiltonConnected” = True

"Class1” = True

TetrahedronReplacedPetersenLineGraph=System`Graph[UndirectedEdge@@@{{1,2},{1,3},{1,4},{1,5},{2,3},{2,4},{2,9},{3,4},{3,25},{4,29},{5,6},{5,7},{5,8},{6,7},{6,8},{6,10},{7,8},{7,13},{8,33},{9,10},{9,11},{9,12},{10,11},{10,12},{11,12},{11,41},{12,45},{13,14},{13,15},{13,16},{14,15},{14,16},{14,17},{15,16},{15,21},{16,34},{17,18},{17,19},{17,20},{18,19},{18,20},{18,22},{19,20},{19,26},{20,37},{21,22},{21,23},{21,24},{22,23},{22,24},{23,24},{23,42},{24,49},{25,26},{25,27},{25,28},{26,27},{26,28},{27,28},{27,30},{28,38},{29,30},{29,31},{29,32},{30,31},{30,32},{31,32},{31,50},{32,53},{33,34},{33,35},{33,36},{34,35},{34,36},{35,36},{35,54},{36,57},{37,38},{37,39},{37,40},{38,39},{38,40},{39,40},{39,46},{40,58},{41,42},{41,43},{41,44},{42,43},{42,44},{43,44},{43,47},{44,51},{45,46},{45,47},{45,48},{46,47},{46,48},{47,48},{48,59},{49,50},{49,51},{49,52},{50,51},{50,52},{51,52},{52,55},{53,54},{53,55},{53,56},{54,55},{54,56},{55,56},{56,60},{57,58},{57,59},{57,60},{58,59},{58,60},{59,60}}]

Robert's Petersen Graphs in 3-Space

1

ShowLabeledGraph[g=Graph[List/@{{1,2},{1,3},{2,3},{2,4},{3,5},{4,5},{4,7},{5,6},{6,7},{1,5},{1,6},{1,4},{1,7},{2,6},{3,7}},List/@{{0,-.5},{-.5,0},{.5,0},{-.5,1},{.5,1},{-.5,2},{.5,2}}]]

RecognizeGraph[g]

Edges[g]//Length

Graph[g]

2

3

4

5

6

7

GraphData

GraphClassString

GraphClassString["PetersenGraph"]

GraphDataString

file=OpenWrite["~/TetrahedronReplacedPetersenLineGraph.m"]

WriteString[file,GraphDataString[TetrahedronReplacedPetersenLineGraph,
"StandardName"->"TetrahedronReplacedPetersenLineGraph",
"Name"->"tetrahedron\[Hyphen]replaced Petersen line graph",
"Embeddings"->None,
"Skip"->{"ChromaticPolynomial","TuttePolynomial"},
Debug->True,
TimeConstraint->100
]]//Timing//AbsoluteTiming

Close[file]