Function Repository Resource:

PolyhedralGraphQ

Source Notebook

Determine if a graph is polyhedral

Contributed by: Ed Pegg Jr

ResourceFunction["PolyhedralGraphQ"][g]

returns True if graph g is polyhedral.

Details

A graph is polyhedral if it is both planar and 3-connected.

A graph is 3-connected if it will remain connected after the removal of any two edges.

If the edges in a graph can be interpreted as edges in a convex polyhedron, then the graph is polyhedral.

Examples

Basic Examples (3)

The tetrahedral graph is polyhedral:

In[1]:=

$ResourceFunction["PolyhedralGraphQ"][\!\(\* GraphicsBox[ NamespaceBox["NetworkGraphics", DynamicModuleBox[{Typeset`graph = HoldComplete[ Graph[{1, 2, 3, 4}, {Null, SparseArray[ Automatic, {4, 4}, 0, {1, {{0, 3, 6, 9, 12}, {{2}, {3}, {4}, {1}, {3}, {4}, { 1}, {2}, {4}, {1}, {2}, {3}}}, Pattern}]}, {VertexCoordinates -> {{Rational[-1, 2] 3^Rational[1, 2], Rational[-1, 2]}, {Rational[1, 2] 3^Rational[1, 2], Rational[-1, 2]}, {0, 1}, {0, 0}}}]]}, TagBox[GraphicsGroupBox[ GraphicsComplexBox[{{-0.8660254037844386, -0.5}, { 0.8660254037844386, -0.5}, {0., 1.}, {0., 0.}}, { {Hue[0.6, 0.7, 0.5], Opacity[0.7], Arrowheads[0.], ArrowBox[{{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}, 0.020399597244776385`]}, {Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[0.7]}], DiskBox[1, 0.020399597244776385], DiskBox[2, 0.020399597244776385], DiskBox[3, 0.020399597244776385], DiskBox[4, 0.020399597244776385]}}]], MouseAppearanceTag["NetworkGraphics"]], AllowKernelInitialization->False]], DefaultBaseStyle->"NetworkGraphics", FormatType->TraditionalForm, FrameTicks->None, ImageSize->{53.25, Automatic}]\)]$

Out[1]=

The diamond graph is not polyhedral, since it can be disconnected by removing two edges:

In[2]:=

$ResourceFunction["PolyhedralGraphQ"][\!$\* GraphicsBox[ NamespaceBox["NetworkGraphics", DynamicModuleBox[{Typeset`graph = HoldComplete[ Graph[{1, 2, 3, 4}, {Null, SparseArray[ Automatic, {4, 4}, 0, {1, {{0, 2, 4, 7, 10}, {{3}, {4}, {3}, {4}, {1}, {2}, { 4}, {1}, {2}, {3}}}, Pattern}]}, {VertexCoordinates -> {{ Rational[1, 2], Rational[1, 2]}, { Rational[1, 2], Rational[-1, 2]}, {0, 0}, {1, 0}}}]]}, TagBox[GraphicsGroupBox[ GraphicsComplexBox[{{0.5, 0.5}, {0.5, -0.5}, {0., 0.}, {1., 0.}}, { {Hue[0.6, 0.7, 0.5], Opacity[0.7], Arrowheads[0.], ArrowBox[{{1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}, 0.01273]}, {Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[0.7]}], DiskBox[1, 0.01273], DiskBox[2, 0.01273], DiskBox[3, 0.01273], DiskBox[4, 0.01273]}}]], MouseAppearanceTag["NetworkGraphics"]], AllowKernelInitialization->False]], DefaultBaseStyle->"NetworkGraphics", FormatType->TraditionalForm, FrameTicks->None, ImageSize->{53.25, Automatic}]$]$

Out[2]=

The Petersen graph is not polyhedral since it is not planar:

In[3]:=

$ResourceFunction["PolyhedralGraphQ"][\!\(\* GraphicsBox[ NamespaceBox["NetworkGraphics", DynamicModuleBox[{Typeset`graph = HoldComplete[ Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, {Null, SparseArray[ Automatic, {10, 10}, 0, {1, {{0, 3, 6, 9, 12, 15, 18, 21, 24, 27, 30}, {{3}, { 4}, {6}, {4}, {5}, {7}, {1}, {5}, {8}, {1}, {2}, {9}, { 2}, {3}, {10}, {1}, {7}, {10}, {2}, {6}, {8}, {3}, {7}, { 9}, {4}, {8}, {10}, {5}, {6}, {9}}}, Pattern}]}, {VertexCoordinates -> {{0., 1.}, {-0.951, 0.309}, {-0.588, -0.809}, {0.588, -0.809}, {0.951, 0.309}, { 0., 2.}, {-1.902, 0.618}, {-1.176, -1.618}, { 1.176, -1.618}, {1.902, 0.618}}}]]}, TagBox[GraphicsGroupBox[ GraphicsComplexBox[{{0., 1.}, {-0.951, 0.309}, {-0.588, -0.809}, {0.588, -0.809}, {0.951, 0.309}, { 0., 2.}, {-1.902, 0.618}, {-1.176, -1.618}, { 1.176, -1.618}, {1.902, 0.618}}, { {Hue[0.6, 0.7, 0.5], Opacity[0.7], Arrowheads[0.], ArrowBox[{{1, 3}, {1, 4}, {1, 6}, {2, 4}, {2, 5}, {2, 7}, { 3, 5}, {3, 8}, {4, 9}, {5, 10}, {6, 7}, {6, 10}, {7, 8}, { 8, 9}, {9, 10}}, 0.03574040219378426]}, {Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[0.7]}], DiskBox[1, 0.03574040219378426], DiskBox[2, 0.03574040219378426], DiskBox[3, 0.03574040219378426], DiskBox[4, 0.03574040219378426], DiskBox[5, 0.03574040219378426], DiskBox[6, 0.03574040219378426], DiskBox[7, 0.03574040219378426], DiskBox[8, 0.03574040219378426], DiskBox[9, 0.03574040219378426], DiskBox[10, 0.03574040219378426]}}]], MouseAppearanceTag["NetworkGraphics"]], AllowKernelInitialization->False]], DefaultBaseStyle->"NetworkGraphics", FormatType->TraditionalForm, FrameTicks->None, ImageSize->{55.5, Automatic}]\)]$