k-Colorable Graph

Author

Eric W. Weisstein
October 2, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/k-ColorableGraph.nb.

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

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

Chromatic Number Computation

Timing[chromatic=Table[ChromaticNumber/@Graphs[n],{n,6}];]

Timing[chromatic=Table[ChromaticNumber/@Graphs[n],{n,8}];]

Simple

Counts

chromaticcounts=Map[Length,Split/@Sort/@chromatic,{2}]

Transpose[PadRight[#,Length[Last[chromaticcounts]]]&/@chromaticcounts]

Rest[FoldList[Plus,0,%]]

1-Colorable

ShowGraphArray[Flatten[Partition[#,8,8,{1,1},{}]&/@Map[MinimalColoring[RecognizeGraph[#],Colors->{Red,Blue}]&,Table[Graphs[n][[Flatten[Position[chromatic[[n]],_?(#≤1&)]]]],{n,5}],{2}],
1],
VertexColor->Red,
VertexStyle->Disk[.15],
AspectRatio->1,
PlotRange->All,
GraphicsSpacing->.5]

2-Colorable

ShowGraphArray[Flatten[Partition[#,8,8,{1,1},{}]&/@Map[MinimalColoring[RecognizeGraph[#],Colors->{Red,Blue}]&,Table[Graphs[n][[Flatten[Position[chromatic[[n]],_?(#≤2&)]]]],{n,5}],{2}],
1],
VertexColor->Red,
VertexStyle->Disk[.15],
AspectRatio->1,
GraphicsSpacing->.5]

3-Colorable

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[RecognizeGraph[#],Colors->{Red,Blue,Green}]&,Table[Graphs[n][[Flatten[Position[chromatic[[n]],_?(#≤3&)]]]],{n,5}],{2}],
1],
VertexColor->Red,
VertexStyle->Disk[.15],
AspectRatio->1,
GraphicsSpacing->.5]

4-Colorable

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[RecognizeGraph[#],Colors->{Red,Blue,Green,Black}]&,Table[Graphs[n][[Flatten[Position[chromatic[[n]],_?(#≤4&)]]]],{n,5}],{2}],
1],
VertexColor->Red,
VertexStyle->Disk[.15],
AspectRatio->1,
GraphicsSpacing->.5]

Connected

Counts

connected=Flatten[Position[#,_?ConnectedQ,{1}]]&/@Graphs/@Range[8];

connectedchromatic=MapIndexed[chromatic[[#2[[1]]]][[#1]]&,connected];

connectedchromaticcounts=Map[Length,Split/@Sort/@connectedchromatic,{2}]

Transpose[PadRight[#,Length[Last[connectedchromaticcounts]]]&/@connectedchromaticcounts]

Rest[FoldList[Plus,0,%]]

connectedcolored=Rest[FoldList[Plus,0,connected]]

2-Colorable Connected

ShowGraphArray[Flatten[Partition[#,8,8,{1,1},{}]&/@Map[MinimalColoring[RecognizeGraph[#],Colors->{Red,Blue}]&,Table[Select[Graphs[n][[Flatten[Position[chromatic[[n]],_?(#≤2&)]]]],ConnectedQ],{n,5}],{2}],
1],
VertexColor->Red,
VertexStyle->Disk[.15],
AspectRatio->1,
GraphicsSpacing->.5]

3-Colorable Connected

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[RecognizeGraph[#],Colors->{Red,Blue,Green}]&,Table[Select[Graphs[n][[Flatten[Position[chromatic[[n]],_?(#≤3&)]]]],ConnectedQ],{n,5}],{2}],
1],
VertexColor->Red,
VertexStyle->Disk[.15],
AspectRatio->1,
GraphicsSpacing->.5]

4-Colorable Connected

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[RecognizeGraph[#],Colors->{Red,Blue,Green,Black}]&,Table[Select[Graphs[n][[Flatten[Position[chromatic[[n]],_?(#≤4&)]]]],ConnectedQ],{n,5}],{2}],
1],
VertexColor->Red,
VertexStyle->Disk[.15],
AspectRatio->1,
GraphicsSpacing->.5]

Labeled

Counts

labeledchromatic=Table[ChromaticNumber/@LabeledGraphs[n],{n,6}];//Timing

labeledchromaticcounts=Map[Length,Split/@Sort/@labeledchromatic,{2}]

Transpose[PadRight[#,Length[Last[labeledchromaticcounts]]]&/@labeledchromaticcounts]

Rest[FoldList[Plus,0,%]]

labeled={{1,1,1,1,1,1},{1,2,7,41,376,5177},{1,2,8,63,958,27554},{1,2,8,64,1023,32596},{1,2,8,64,1024,32767},{1,2,8,64,1024,32768}};

k-Colorable

n!(2^((n^2)/2))SeriesCoefficient[((Sum[((2^(-(s^2)/2))/(s!))(x^s),{s,∞}])^k),{x,0,n}]

TableForm[Table[n!(2^((n^2)/2))SeriesCoefficient[((Sum[((2^(-(s^2)/2))/(s!))(x^s),{s,500}])^k),{x,0,n}],{n,10},{k,10}],TableAlignments->Right]

2-Colorable

A047863

Sum[Binomial[n,k](2^(k(n-k))),{k,0,n}]

Sum[Binomial[n,k](2^(k(n-k))),{k,0,n}]

FunctionExpand[Binomial[n,k](2^(k(n-k)))]//FullSimplify

FullSimplify[(((2^(k (-k+n))) Gamma[1+n])/(Gamma[1+k] Gamma[1-k+n])),0≤k≤n&&(k|n)∈Integers]

Sum[(((2^(k (-k+n))) n!)/(k! (-k+n)!)),{k,0,n}]

Sum[(((2^(k (-k+n))) Gamma[1+n])/(Gamma[1+k] Gamma[1-k+n])),{k,0,n}]

Series[Sum[Exp[(2^n)x]((x^n)/(n!)),{n,0,10}],{x,0,10}]

Table[Sum[Binomial[n,k](2^(k(n-k))),{k,0,n}],{n,0,10}]

FindGeneratingFunction[{2,6,26,162,1442,18306,330626,8488962},x]

FindLinearRecurrence[{2,6,26,162,1442,18306,330626,8488962}]

Sqrt[Plus@@MapIndexed[#1/(#2[[1]]-1)! x^(#2[[1]]-1)&,Table[Sum[Binomial[n,k](2^(k(n-k))),{k,0,n}],{n,0,10}]]]

Series[Sqrt[Plus@@MapIndexed[#1/(#2[[1]]-1)! x^(#2[[1]]-1)&,Table[Sum[Binomial[n,k](2^(k(n-k))),{k,0,n}],{n,0,20}]]],{x,0,10}]

Normal[CoefficientList[%,x]]Table[n!,{n,0,10}]

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[#,Colors->{Red,Blue}]&,Table[LabeledGraphs[n][[Flatten[Position[labeledchromatic[[n]],_?(#≤2&)]]]],{n,2,3}],{2}],
1],
VertexColor->Red,VertexStyle->Disk[.2],
AspectRatio->1,PlotRange->All,
VertexLabel->Range[5],VertexLabelPosition->{-.1,.3},
GraphicsSpacing->.5]

3-Colorable

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[#,Colors->{Red,Blue,Green}]&,Table[LabeledGraphs[n][[Flatten[Position[labeledchromatic[[n]],_?(#≤3&)]]]],{n,2,3}],{2}],
1],
VertexColor->Red,VertexStyle->Disk[.2],
AspectRatio->1,PlotRange->All,
VertexLabel->Range[5],VertexLabelPosition->{-.1,.3},
GraphicsSpacing->.5]

Labeled Connected

labeledchromaticconnected=Table[ChromaticNumber/@Select[LabeledGraphs[n],ConnectedQ],{n,6}];//Timing

labeledchromaticconnectedcounts=Prepend[Prepend[#,0]&/@Rest[Map[Length,Split/@Sort/@labeledchromaticconnected,{2}]],{1}]

Transpose[PadRight[#,Length[Last[labeledchromaticconnectedcounts]]]&/@labeledchromaticconnectedcounts]

labeledconnected=Rest[FoldList[Plus,0,%]]

labeledconnected={{1,0,0,0,0,0},{1,1,3,19,195,3031},{1,1,4,37,667,21886},{1,1,4,38,727,26538},{1,1,4,38,728,26703},{1,1,4,38,728,26704}};

2-Colorable

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[#,Colors->{Red,Blue}]&,Table[Select[LabeledGraphs[n],ConnectedQ][[Flatten[Position[labeledchromaticconnected[[n]],_?(#≤2&)]]]],{n,2,4}],{2}],
1],
VertexColor->Red,VertexStyle->Disk[.2],
AspectRatio->1,PlotRange->All,
VertexLabel->Range[5],VertexLabelPosition->{-.1,.3},
GraphicsSpacing->.5]

3-Colorable

ShowGraphArray[Flatten[Partition[#,10,10,{1,1},{}]&/@Map[MinimalColoring[#,Colors->{Red,Blue,Green}]&,Table[Select[LabeledGraphs[n],ConnectedQ][[Flatten[Position[labeledchromaticconnected[[n]],_?(#≤3&)]]]],{n,2,4}],{2}],
1],
VertexColor->Red,VertexStyle->Disk[.2],
AspectRatio->1,PlotRange->All,
VertexLabel->Range[5],VertexLabelPosition->{-.1,.3},
GraphicsSpacing->.5]