Pentagonal Wedge Graph

Author

Eric W. Weisstein
May 14, 2023

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

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

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

Base polyhedron

Graphics3D[{Opacity[.8],PolyhedronData["PentagonalWedge","Polyhedron"]},Boxed->False]

Properties

GraphData["PentagonalWedgeGraph","StandardNames"]

GraphData["PentagonalWedgeGraph",{"V","E","F"}]

GraphData["PentagonalWedgeGraph","DualGraph","Name"]

Definition

Michon

http://nbarth.net/notes/src/notes-calc-raw/others/X-numericana/polyhedra.htm#hexahedra

Wikipedia

https://en.wikipedia.org/wiki/Hexahedron#Convex,_Others

Embeddings

<<MathWorld`Graphs`

GraphData["PentagonalWedgeGraph","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["PentagonalWedgeGraph","EdgeList"]]

Default embedding

GraphPlot[GraphData["PentagonalWedgeGraph","Edges"],GraphLayout->"SpringEmbedding"]

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

RecognizeGraph[g]

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

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

RecognizeGraph[g]

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

RecognizeGraph[g]

3D Perspective from pentagonal wedge

<<MathWorld`PolyhedronOperations`

wedge=PolyhedronData["PentagonalWedge","Polyhedron"]

g=Graph[Range[8],UndirectedEdge@@@PolyhedronEdges[wedge],VertexCoordinates->PolyhedronCoordinates[wedge]]

2D projection from pentagonal wedge

wedge=PolyhedronData["PentagonalWedge","Polyhedron"]

Manipulate[PolyhedronProjectionGraph[wedge,{x,y,z}],{x,-2,2},{y,-2,2},{z,-2,2}]

g=

g=PolyhedronProjectionGraph[PolyhedronData["PentagonalWedge","Polyhedron"],{0,1,4}]

Embedding types

GraphDataEmbeddings[GraphData["PentagonalWedgeGraph","EdgeList"]]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["PentagonalWedgeGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

g=RotateGraph[MinimalCrossingGraph[GraphData["PentagonalWedgeGraph"],"CrossingNumber"->-1]]

RecognizeGraph[g]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData["PentagonalWedgeGraph"]]

Tally[ReverseSort[Length/@faces]]

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

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{,}

Tutte embedding construction 5

GraphPlot[RotateGraph[,-4Pi/5]]

h=v[[4,2]]//FullSimplify

e[l__]:=Sequence@@Partition[{l},2,1]

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

RecognizeGraph[g]

Tutte embedding construction 4

GraphPlot[RotateGraph[]]

e[l__]:=Sequence@@Partition[{l},2,1]

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

RecognizeGraph[g]

Tutte embedding construction 3

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Circulant

GraphData["PentagonalWedgeGraph","Circulant"]

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

Halin

GraphData["PentagonalWedgeGraph","Halin"]

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

LCF

GraphData["PentagonalWedgeGraph","LCF"]

GraphData["PentagonalWedgeGraph","LCFSignature"]

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

LCF compute

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

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

gs=LCFGraph@@@lcf

UnitDistance

GraphData["PentagonalWedgeGraph","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

gs={RotateGraph[,{6,2}],,,,}

Matchstick

GraphData["PentagonalWedgeGraph","Matchstick"]

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

3D default

Graph3D[GraphData["PentagonalWedgeGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["PentagonalWedgeGraph","Polyhedral"]

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

Graphics3D[{FaceForm[Green,Red],GraphData["PentagonalWedgeGraph","Polyhedron"]}]

3D Canonical

GraphData["PentagonalWedgeGraph","Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData["PentagonalWedgeGraph","Polyhedron","Canonical"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["PentagonalWedgeGraph"],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->1000,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

GraphData

GraphPropertyString

GraphDataClassString["PentagonalWedgeGraph"]