Drape Graph

Author

Eric W. Weisstein
July 26, 2026

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

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

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

Figure

GraphicsGrid[
Partition[
StyleGraphs[
GraphData["DrapeGraph","Graph","All"]
],
UpTo[3]
],
Dividers->All
]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["DrapeGraph","StandardName"]

GraphData["DrapeGraph","StandardNames"]

Primary

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

Robertson et al. 2019

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

CubicGraphQ[g]

r=RecognizeGraph[g]

CrossingNumber[g]

All

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

Embedding types

GraphDataEmbeddings[GraphData["DrapeGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["DrapeGraph","Planar"]

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

MinimalLocalCrossing

GraphData["DrapeGraph","LocalCrossingNumber"]

GraphData["DrapeGraph","Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalLocalCrossing construction

GraphPlot@

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

RecognizeGraph@g

LocalCrossingCount@g

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["DrapeGraph","Circulant"]

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

Halin

GraphData["DrapeGraph","Halin"]

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

LCF

GraphData["DrapeGraph","LCF"]

GraphData["DrapeGraph","LCFSignature"]

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

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

LCF compute all

Divisors[GraphData["DrapeGraph","V"]]

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

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

lcf

LCFGraph@@@lcf//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2,1])]//Timing

UnitDistance

GraphData["DrapeGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

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

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

gs={,,};

Matchstick

GraphData["DrapeGraph","Matchstick"]

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

3D default

Graph3D[GraphData["DrapeGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["DrapeGraph","Polyhedral"]

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