Drum Graph

Author

Eric W. Weisstein
July 26, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/DrumGraph.nb.

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

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

Figure

GraphicsGrid[
Partition[
StyleGraphs[
GraphData["DrumGraph","Graph","All"]
],
UpTo[6]
],
Dividers->All
]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["DrumGraph","StandardName"]

GraphData["DrumGraph","StandardNames"]

Robertson et al. 2019

v=Join[Sequence@@Table[{i,j},{i,0,2},{j,0,3}],{{-1,3/2},{3,3/2}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{1,5},{5,9},{9,10},{10,11},{11,12},{8,12},{4,8},{3,4},{2,3},{1,2},{1,13},{4,13},{9,14},{12,14},{5,6},{7,8},{2,7},{7,10},{6,11},{3,6},{13,14}}],VertexCoordinates->v,VertexLabels->"Name"]

CubicGraphQ[g]

r=RecognizeGraph[g]

PlanarGraphQ[g]

CrossingNumber[g,TimeConstraint->10]

GraphData[r,"Graph","All"]

ToCommonEdges[g,GraphData[r]]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["DrumGraph","EdgeList"]]

Default embedding

GraphPlot[GraphData["DrumGraph","Edges"],GraphLayout->"HighDimensionalEmbedding"]

v=Join[CirclePoints[{1,Pi/2},10],{#(Sqrt[(5/8)-((Sqrt[5])/8)]),0}&/@{-1,1},{0,# 3/4}&/@{-1,1}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[{1,10},1,14,8],{4,14},e[3,13,9],{6,13},e[5,11,2],e[10,12,7],{11,12}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["DrumGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

GraphData["DrumGraph","Polyhedral"]

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

GraphPlot@RotateGraph[,-Pi/6]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,Pi/2]

v={{0,0},{1/2,0},{1,0},{1,1},{1/2,1},{0,1},{(1/6),(1/4)},{(1/2)-(1/12),(1/4)},{(1/2),(1/4)},{(1/2)+(1/12),(1/4)},{(5/6),(1/4)},{(1/2)-(1/12),1/2},{(1/2)+(1/12),1/2},{1/2,3/4}};
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[Sort/@{Sequence@@Partition[Range[6],2,1,1],{1,7},{7,8},{8,9},{9,10},{10,11},{3,11},{12,13},{5,14},{7,14},{11,14},{8,12},{10,13},{2,9},{6,12},{4,13}}],VertexLabels->"Name",VertexCoordinates->v]

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,4Pi/5]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,Pi/6]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

gs=UnlabelGraph/@{,,,,,,}

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

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

Circulant

GraphData["DrumGraph","Circulant"]

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

Line graph

GraphData["DrumGraph","Line"]

LineGraphQ[GraphData["DrumGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["DrumGraph"]]

Halin

GraphData["DrumGraph","Halin"]

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

Rigid

GraphData["DrumGraph","Rigid"]

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

Flexible

GraphData["DrumGraph","Flexible"]

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

LCF

GraphData["DrumGraph","LCF"]

GraphData["DrumGraph","HamiltonianCycleCount"]

GraphData["DrumGraph","LCFSignature"]

GraphData["DrumGraph","LCFNotations"]

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

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

LCF compute all

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

Tally[(lcf=LCF[GraphData["DrumGraph"],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["DrumGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

g=;

Matchstick

GraphData["DrumGraph","Matchstick"]

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

3D default

Graph3D[GraphData["DrumGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["DrumGraph","Polyhedral"]

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