Function Repository Resource:

PerfectGraphQ

Source Notebook

Test whether a graph is perfect

Contributed by: Wolfram Staff (original content by Sriram V. Pemmaraju and Steven S. Skiena)

ResourceFunction["PerfectGraphQ"][g]

yields True if the Graph g is perfect and False otherwise.

Details and Options

A graph is perfect if for every induced subgraph the size of the largest clique equals the chromatic number.

Examples

Basic Examples (2) 

Test a perfect Graph:

In[1]:=
ResourceFunction["PerfectGraphQ"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5}, {Null, 
SparseArray[
         Automatic, {5, 5}, 0, {1, {{0, 3, 6, 9, 11, 14}, {{3}, {4}, {5}, {3}, {4}, {
            5}, {1}, {2}, {5}, {1}, {2}, {1}, {2}, {3}}}, Pattern}]}, {VertexCoordinates -> {{0, 1}, {0, -1}, {-1, 0}, {1, 0}, {0, 0}}}]]}, 
TagBox[GraphicsGroupBox[
        GraphicsComplexBox[{{0., 1.}, {0., -1.}, {-1., 0.}, {1., 0.}, {0., 0.}}, {
{Hue[0.6, 0.7, 0.5], Opacity[0.7], LineBox[{{1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 4}, {2, 5}, {
            3, 5}}]}, 
{Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[0.7]}], DiskBox[1, 0.02261146496815286], DiskBox[2, 0.02261146496815286], DiskBox[3, 0.02261146496815286], DiskBox[4, 0.02261146496815286], DiskBox[5, 0.02261146496815286]}}]],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FormatType->TraditionalForm,
FrameTicks->None]\)]
Out[1]=

Test an imperfect Graph:

In[2]:=
ResourceFunction["PerfectGraphQ"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6}, {Null, 
SparseArray[
         Automatic, {6, 6}, 0, {1, {{0, 2, 4, 6, 8, 11, 14}, {{4}, {5}, {5}, {6}, {5}, {
            6}, {1}, {6}, {1}, {2}, {3}, {2}, {3}, {4}}}, Pattern}]}, {VertexCoordinates -> {{3, 3}, {1, 1}, {4, 4}, {2, 2}, {4, 1}, {1, 4}}}]]}, 
TagBox[GraphicsGroupBox[
        GraphicsComplexBox[{{3., 3.}, {1., 1.}, {4., 4.}, {2., 2.}, {
         4., 1.}, {1., 4.}}, {
{Hue[0.6, 0.7, 0.5], Opacity[0.7], LineBox[{{1, 4}, {1, 5}, {2, 5}, {2, 6}, {3, 5}, {3, 6}, {
            4, 6}}]}, 
{Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[0.7]}], DiskBox[1, 0.030239520958083826], DiskBox[2, 0.030239520958083826], DiskBox[3, 0.030239520958083826], DiskBox[4, 0.030239520958083826], DiskBox[5, 0.030239520958083826], DiskBox[6, 0.030239520958083826]}}]],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FormatType->TraditionalForm,
FrameTicks->None]\)]
Out[2]=

Properties and Relations (6) 

The GraphComplement of a perfect Graph is perfect:

In[3]:=
g = \!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6, 7}, {Null, 
SparseArray[
          Automatic, {7, 7}, 0, {1, {{0, 4, 6, 7, 11, 15, 19, 24}, {{4}, {5}, {6}, {
             7}, {5}, {7}, {6}, {1}, {5}, {6}, {7}, {1}, {2}, {4}, {
             7}, {1}, {3}, {4}, {7}, {1}, {2}, {4}, {5}, {6}}}, Pattern}]}, {VertexCoordinates -> {{1, 1}, {4, 3}, {3, 
Rational[3, 2]}, {6, 1}, {3, 6}, {3, 2}, {3, 3}}}]]}, 
TagBox[GraphicsGroupBox[
         GraphicsComplexBox[{{1., 1.}, {4., 3.}, {3., 1.5}, {6., 1.}, {3., 6.}, {3., 2.}, {3., 3.}}, {
{Hue[0.6, 0.7, 0.5], Opacity[0.7], LineBox[{{1, 4}, {1, 5}, {1, 6}, {1, 7}, {2, 5}, {2, 7}, {
             3, 6}, {4, 5}, {4, 6}, {4, 7}, {5, 7}, {6, 7}}]}, 
{Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[0.7]}], DiskBox[1, 0.043048128342245986], DiskBox[2, 0.043048128342245986], DiskBox[3, 0.043048128342245986], DiskBox[4, 0.043048128342245986], DiskBox[5, 0.043048128342245986], DiskBox[6, 0.043048128342245986], DiskBox[7, 0.043048128342245986]}}]],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FormatType->TraditionalForm,
FrameTicks->None]\);
In[4]:=
ResourceFunction["PerfectGraphQ"][g]
Out[4]=
In[5]:=
GraphComplement[g]
Out[5]=
In[6]:=
ResourceFunction["PerfectGraphQ"][%]
Out[6]=

If the graph complement of g is imperfect, then so is g:

In[7]:=
g = \!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6}, {Null, 
SparseArray[
          Automatic, {6, 6}, 0, {1, {{0, 3, 6, 9, 11, 13, 16}, {{3}, {4}, {6}, {4}, {
             5}, {6}, {1}, {5}, {6}, {1}, {2}, {2}, {3}, {1}, {2}, {
             3}}}, Pattern}]}, {VertexCoordinates -> {{
Rational[
             1, 2], Rational[-1, 2] (
               1 + 2 5^Rational[-1, 2])^Rational[1, 2]}, {0, (
              Rational[1, 10] (5 + 5^Rational[1, 2]))^Rational[
              1, 2]}, {
Rational[-1, 2], Rational[-1, 2] (1 + 2 5^Rational[-1, 2])^Rational[
               1, 2]}, {Rational[1, 4] (1 + 5^Rational[1, 2]), Rational[
              1, 2] (Rational[1, 10] (5 - 5^Rational[1, 2]))^Rational[
               1, 2]}, {Rational[1, 4] (-1 - 5^Rational[1, 2]), Rational[
              1, 2] (Rational[1, 10] (5 - 5^Rational[1, 2]))^Rational[
               1, 2]}, {0, 0}}}]]}, 
TagBox[GraphicsGroupBox[
         GraphicsComplexBox[{{0.5, -0.6881909602355868}, {0., 0.85065080835204}, {-0.5, -0.6881909602355868}, {
          0.8090169943749475, 0.2628655560595668}, {-0.8090169943749475, 0.2628655560595668}, {0., 0.}}, {
{Hue[0.6, 0.7, 0.5], Opacity[0.7], LineBox[{{1, 3}, {1, 4}, {1, 6}, {2, 4}, {2, 5}, {2, 6}, {
             3, 5}, {3, 6}}]}, 
{Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[0.7]}], DiskBox[1, 0.019434941751084317], DiskBox[2, 0.019434941751084317], DiskBox[3, 0.019434941751084317], DiskBox[4, 0.019434941751084317], DiskBox[5, 0.019434941751084317], DiskBox[6, 0.019434941751084317]}}]],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FormatType->TraditionalForm,
FrameTicks->None]\);
In[8]:=
gc = GraphComplement[g]
Out[8]=
In[9]:=
ResourceFunction["PerfectGraphQ"] /@ {gc, g}
Out[9]=

Bipartite graphs are perfect:

In[10]:=
g = \!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6, 7, 8}, {Null, 
SparseArray[
          Automatic, {8, 8}, 0, {1, {{0, 3, 6, 9, 12, 15, 18, 21, 24}, {{2}, {3}, {5}, {
             1}, {4}, {6}, {1}, {4}, {7}, {2}, {3}, {8}, {1}, {6}, {
             7}, {2}, {5}, {8}, {3}, {5}, {8}, {4}, {6}, {7}}}, Pattern}]}, {VertexCoordinates -> {{-0.333, -0.333}, {-1., -1.}, {-0.333, 0.333}, {-1., 1.}, {0.333, -0.333}, {1., -1.}, {
           0.333, 0.333}, {1., 1.}}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], 
LineBox[{{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}, {
DynamicLocation[
             "VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}, {
DynamicLocation[
             "VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}, {
DynamicLocation[
             "VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}, {
DynamicLocation[
             "VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}, {
DynamicLocation[
             "VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}, {
DynamicLocation[
             "VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}, {
DynamicLocation[
             "VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}, {
DynamicLocation[
             "VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}, {
DynamicLocation[
             "VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}, {
DynamicLocation[
             "VertexID$6", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}, {
DynamicLocation[
             "VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
DiskBox[{-0.333, -0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
DiskBox[{-1., -1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
DiskBox[{-0.333, 0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
DiskBox[{-1., 1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
DiskBox[{0.333, -0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
DiskBox[{1., -1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$6"], 
TagBox[
DiskBox[{0.333, 0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$7"], 
TagBox[
DiskBox[{1., 1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$8"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
         3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{0.9999999999999911, 98.99999999999999}, {-50.92, 47.08}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
ImageSize->100]\);
In[11]:=
{BipartiteGraphQ[g], ResourceFunction["PerfectGraphQ"][g]}
Out[11]=

Line graphs of bipartite graphs are perfect:

In[12]:=
LineGraph[\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6, 7, 8}, {Null, 
SparseArray[
         Automatic, {8, 8}, 0, {1, {{0, 3, 6, 9, 12, 15, 18, 21, 24}, {{2}, {3}, {5}, {
            1}, {4}, {6}, {1}, {4}, {7}, {2}, {3}, {8}, {1}, {6}, {
            7}, {2}, {5}, {8}, {3}, {5}, {8}, {4}, {6}, {7}}}, Pattern}]}, {VertexCoordinates -> {{-0.333, -0.333}, {-1., -1.}, {-0.333, 0.333}, {-1., 1.}, {0.333, -0.333}, {1., -1.}, {0.333, 0.333}, {1., 1.}}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], 
LineBox[{{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}, {
DynamicLocation[
            "VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}, {
DynamicLocation[
            "VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}, {
DynamicLocation[
            "VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}, {
DynamicLocation[
            "VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}, {
DynamicLocation[
            "VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}, {
DynamicLocation[
            "VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}, {
DynamicLocation[
            "VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}, {
DynamicLocation[
            "VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}, {
DynamicLocation[
            "VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$7", Automatic, Center]}, {
DynamicLocation[
            "VertexID$6", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}, {
DynamicLocation[
            "VertexID$7", Automatic, Center], 
DynamicLocation["VertexID$8", Automatic, Center]}}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
DiskBox[{-0.333, -0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
DiskBox[{-1., -1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
DiskBox[{-0.333, 0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
DiskBox[{-1., 1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
DiskBox[{0.333, -0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
DiskBox[{1., -1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$6"], 
TagBox[
DiskBox[{0.333, 0.333}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$7"], 
TagBox[
DiskBox[{1., 1.}, 0.02261146496815286], "DynamicName", BoxID -> "VertexID$8"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{0.9999999999999911, 98.99999999999999}, {-50.92, 47.08}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
ImageSize->100]\)]
Out[12]=
In[13]:=
ResourceFunction["PerfectGraphQ"][%]
Out[13]=

Interval graphs (and chordal graphs in general) are perfect:

In[14]:=
ResourceFunction["IntervalGraph"][{Interval[{1, 6}], Interval[{2, 4}],
   Interval[{3, 11}], Interval[{5, 10}], Interval[{7, 8}], Interval[{9, 13}], Interval[{12, 14}]}, VertexLabels -> "Name", GraphLayout -> "CircularEmbedding"]
Out[15]=
In[16]:=
ResourceFunction["PerfectGraphQ"][%]
Out[16]=

For named graphs, you can check the "Perfect" and "Imperfect" properties within GraphData without computing PerfectGraphQ:

In[17]:=
g = GraphData["OctahedralGraph"]
Out[17]=
In[18]:=
GraphData["OctahedralGraph", "Perfect"]
Out[18]=
In[19]:=
GraphData["OctahedralGraph", "Imperfect"]
Out[19]=
In[20]:=
ResourceFunction["PerfectGraphQ"][g]
Out[20]=

Version History

  • 1.0.0 – 22 July 2020

Related Resources

License Information