Chromatic Invariant

Author

Eric W. Weisstein
April 20, 2023

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

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

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

Parametrized family table

<<MathWorld`Graphs`

GraphDataCountTable["ChromaticInvariant",{"Alkane"->000007,"Andrasfai"->280333,"Antiprism"->294152,"Bishop"->000007,"BlackBishop"->295170,"Book"->000012,"Centipede"->000007,"CocktailParty"->295166,"Complete"->000142,"CompleteBipartite"->048144,"CompleteTripartite"->182553,"CrossedPrism"->295168,"Crown"->295171,"Cycle"->000012,"DiagonalIntersection"->300814,"Dipyramid"->000295,"DoubleCone"->000007,"FibonacciCube"->295927,"FoldedCube"->295172,"Gear"->000027,{"Grid",2}->182517,{"Grid",3}->295173,"HalvedCube"->295174,"Hanoi"->295175,"Helm"->000007,"Hypercube"->295176,"King"->295177,"Knight"->295178,"Ladder"->000012,"LadderRung"->000007,"Pan"->000007,"Prism"->000295,"Queen"->295187,"Rook"->295184,"RookComplement"->295186,"SierpinskiGasket"->295189,"Sun"->000142,"TorusGrid"->295191,"Trapezohedron"->294152,"Triangular"->295192,"TriangularGrid"->295190,"TriangularHoneycombObtuseKnight"->295194,"TriangularHoneycombQueen"->295195,"Wheel"->000027,"WhiteBishop"->295217}]

Parametrized families

Andrasfai

A280333

seq=Table[GraphData[{"Andrasfai",n},"ChromaticInvariant"],{n,10}]

Table[Derivative[1][System`ChromaticPolynomial[System`CirculantGraph[3 n-1,Range[1,3 n,3]]]][1],{n,5}]//Abs

FindLinearRecurrence[Drop[seq,2]//DeleteMissing]

FindSequenceFunction[Drop[seq,2]//DeleteMissing,n-2]

FindGeneratingFunction[DeleteMissing[seq],x]

Antiprism

Entity["Graph",{"Antiprism",n}]["ChromaticInvariant"]

A294152

seq=Table[GraphData[{"Antiprism",n},"ChromaticInvariant"],{n,3,25}]

FullSimplify[FindSequenceFunction[seq,n-2],n>2&&n∈Integers]

{GoldenRatio,1/GoldenRatio}^2//FunctionExpand//ExpandAll//Factor

Table[(GoldenRatio^(2n))+(GoldenRatio^(-2n))-2 n-1,{n,10}]//FullSimplify

seq=Table[LucasL[2n]-2 n-1,{n,40}]

Table[(GoldenRatio^(2n))+(GoldenRatio^(-2n)),{n,10}]//FullSimplify

Table[LucasL[2n],{n,10}]

coef=FindLinearRecurrence[seq]

Take[seq,Length[coef]]

LinearRecurrence[{5,-8,5,-1},{0,2,11,38},20]

gf=x FindGeneratingFunction[seq,x]

CoefficientList[Series[((x (2+x-(x^2)))/((((-1+x))^2) (1-3 x+(x^2)))),{x,0,20}],x]

Apollonian

seq=Table[GraphData[{"Apollonian",n},"ChromaticInvariant"],{n,6}]

Barbell

seq=Table[GraphData[{"Barbell",n},"ChromaticInvariant"],{n,3,20}]

Bishop n×n

seq=Table[GraphData[{"Bishop",{n,n}},"ChromaticInvariant"],{n,10}]

BlackBishop n×n

A295170

seq=Table[GraphData[{"BlackBishop",{n,n}},"ChromaticInvariant"],{n,10}]

Table[GraphData[{"BlackBishop",{n,n}},"ChromaticPolynomial"],{n,10}]

Book

seq=Table[GraphData[{"Book",n},"ChromaticInvariant"],{n,20}]

Centipede

seq=Table[GraphData[{"Centipede",n},"ChromaticInvariant"],{n,10}]

CocktailParty

A295166

seq=Table[GraphData[{"CocktailParty",n},"ChromaticInvariant"],{n,20}]

Table[Sum[Binomial[n,k](((-1))^(k+n))(n+k-2)!,{k,0,n}],{n,2,20}]

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

Join[{2},Table[Sum[Binomial[n,k](((-1))^(k+n))(n+k-2)!,{k,0,n}],{n,2,20}]]

seq=Join[{2},Table[-Gamma[n-1] HypergeometricU[n-1,2 n,-1],{n,2,20}]]

seq={2,1,11,362,21234,1965624,264398280,48773612880,11824686110160,3646938237505920,1394586705296776320,647624841502298284800,359025601255648673068800,234214938700483636606233600,177617896085186117264114611200,154944426571409730022474894387200};

FindLinearRecurrence[Drop[seq,2]//DeleteMissing]//Head//Timing

FindSequenceFunction[Drop[seq,2]//DeleteMissing,n-2]//Head//Timing

FindGeneratingFunction[DeleteMissing@seq,x]//Head//Timing

Complete

Entity["Graph",{"Complete",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Complete",n},"ChromaticInvariant"],{n,20}]

FindSequenceFunction[Rest@seq,n-1]

FunctionExpand[%]

CompleteBipartite m×n

A291774

Entity["Graph",{"CompleteBipartite",{m,n}}]["ChromaticInvariant"]

Table[GraphData[{"CompleteBipartite",Sort[{m,n}]},"ChromaticInvariant"],{n,20},{m,n}]//Column

Table[GraphData[{"CompleteBipartite",Sort[{m,n}]},"ChromaticInvariant"],{n,10},{m,n}]//Flatten

Join[{1},Table[Sum[k!(((-1))^(k+m))(((k+1))^n)StirlingS2[m,k+2],{k,0,m-1}],{n,2,10},{m,n}]]//Flatten

Table[Piecewise[{{1,m==n==1}},Sum[k!(((-1))^(k+Min[m,n]))(((k+1))^(Max[m,n]))StirlingS2[Min[m,n],k+2],{k,0,Min[m,n]-1}]],{n,20},{m,n}]//Column

DeleteCases[Block[{m,n},{
{m,n}="CompleteBipartite"/.GraphData[#,"NotationRules"],
Piecewise[{{1,m==n==1}},Sum[k!(((-1))^(k+Min[m,n]))(((k+1))^(Max[m,n]))StirlingS2[Min[m,n],k+2],{k,0,Min[m,n]-1}]],
GraphData[#,"ChromaticInvariant"]
}]&/@GraphData["CompleteBipartite"],
{_,x_,x_}]

deletefromfirstmissing[l_]:=Take[l,FirstPosition[l,_Missing,{Length[l]+1}][[1]]-1]

(mn=MapIndexed[Factor@FindSequenceFunction[deletefromfirstmissing@#,n-1]&,Table[GraphData[{"CompleteBipartite",Sort[{n,m}]},"ChromaticInvariant"],{n,2,11},{m,2,20}]])//Column

{
1,
-3+(2^n),
7-6 (2^n)+2 (3^n),
-15+25 (2^n)-20 (3^n)+6 (4^( n)),
31-90 (2^n)+130 (3^n)-90 (4^( n))+24 (5^n),
-63+301 (2^n)-700 (3^n)+840 (4^n)-504 (5^n)+120 (6^n)
}

Table[StirlingS2[n,1],{n,10}]

Table[StirlingS2[n,2],{n,10}]

Table[StirlingS2[n,3],{n,10}]

2!Table[StirlingS2[n,4],{n,10}]

3!Table[StirlingS2[n,5],{n,10}]

Table[Sum[k!(((-1))^(k+m))(((k+1))^n)StirlingS2[m,k+2],{k,0,m-1}],{n,5},{m,n}]

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

(r=MapIndexed[FindLinearRecurrence[deletefromfirstmissing@#]&,Table[GraphData[{"CompleteBipartite",Sort[{n,m}]},"ChromaticInvariant"],{n,11},{m,2,20}]])//Column

-Rest/@Table[StirlingS1[n,n+1-k],{n,10},{k,n}]//Column

CompleteBipartite n×n

A048144

Entity["Graph",{"CompleteBipartite",{n,n}}]["ChromaticInvariant"]

seq=Table[GraphData[{"CompleteBipartite",{n,n}},"ChromaticInvariant"],{n,10}]

FindSequenceFunction[Take[l,7]]

FindSequenceFunction[Take[l,{2,7}]][n-1]//FunctionExpand

Sum[(((k!))^2)((StirlingS2[n,k])^2),{k,0,n}]

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

CompleteTripartite n×n×n

A182553

Entity["Graph",{"CompleteTripartite",{n,n,n}}]["ChromaticInvariant"]

Activate[%/.{\[FormalK]->k,\[FormalL]->l}]//TraditionalForm

n!//FunctionExpand

(sum(k=1,n,stirling(n,k,2)*x^k)^3/x^2),x,-1)

seq=Table[GraphData[{"CompleteTripartite",{n,n,n}},"ChromaticInvariant"],{n,10}]//Quiet

FindSequenceFunction[Take[l,5]]

FindSequenceFunction[Take[l,{2,5}]][n-1]//FunctionExpand

CrossedPrism

A295168

seq=Table[GraphData[{"CrossedPrism",2n},"ChromaticInvariant"],{n,2,10}]

FindSequenceFunction[seq,n-1]//FullSimplify

seq=Table[(5^n)-(2^(n-1)) (3 n+1),{n,30}]

FindLinearRecurrence[seq]

LinearRecurrence[{9,-24,20},{1,11,85},20]

gf=x FindGeneratingFunction[seq,x]

CoefficientList[Series[((-1-2 x-10 (x^2))/((((-1+2 x))^2) (-1+5 x))),{x,0,20}],x]

Crown

A295171

seq=Table[GraphData[{"Crown",n},"ChromaticInvariant"],{n,3,20}]

Sum[(((-1))^k)(k-2)!Binomial[n,j]StirlingS2[n-j,i]StirlingS2[n-j,k-j-i],{i,0,k-j}]

FunctionExpand[(((-1))^k)(k-2)!Binomial[n,j]StirlingS2[n-j,i]StirlingS2[n-j,k-j-i]]//FullSimplify

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

Table[Sum[(((-1))^k)(k-2)!Binomial[n,j]StirlingS2[n-j,i]StirlingS2[n-j,k-j-i],{k,2,2n},{j,0,n},{i,0,k-j}],{n,3,20}]

FindSequenceFunction[DeleteMissing@seq,n-2]

FindSequenceFunction[Rest@DeleteMissing@seq,n-3]

FindLinearRecurrence[DeleteMissing@seq]

FindLinearRecurrence[Rest@DeleteMissing@seq]

FindGeneratingFunction[DeleteMissing@seq,x]

CubeConnectedCycle

Entity["Graph",{"CubeConnectedCycle",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"CubeConnectedCycle",n},"ChromaticInvariant"],{n,3,8}]

Cycle

Entity["Graph",{"Cycle",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Cycle",n},"ChromaticInvariant"],{n,3,20}]

CycleComplement

seq=Table[GraphData[{"CycleComplement",n},"ChromaticInvariant"],{n,3,20}]

FindLinearRecurrence[DeleteMissing@Drop[seq,2]]//Head//Timing

Do[Print[{k,FindLinearRecurrence[DeleteMissing@Drop[seq,k]]//Head//Timing}],{k,0,5}]

FindSequenceFunction[DeleteMissing@Drop[seq,2],n-2]//Head//Timing

FindGeneratingFunction[DeleteMissing@Drop[seq,2],x]//Head//Timing

DiagonalIntersection

A300814

seq=Table[GraphData[{"DiagonalIntersection",n},"ChromaticInvariant"],{n,3,14}]

Empty

Entity["Graph",{"Empty",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Empty",n},"ChromaticInvariant"],{n,20}]

FibonacciCube

A295927

seq=Table[GraphData[{"FibonacciCube",n},"ChromaticInvariant"],{n,10}]

FoldedCube

A295172

seq=Table[GraphData[{"FoldedCube",n},"ChromaticInvariant"],{n,2,10}]

FindSequenceFunction[Take[l,{2,5}]][n-1]

Gear

seq=Table[GraphData[{"Gear",n},"ChromaticInvariant"],{n,3,20}]

FindSequenceFunction[seq,n-2]

Grid m×n

Entity["Graph",{"Grid",{m,n}}]["ChromaticInvariant"]

Grid n×n

Entity["Graph",{"Grid",{n,n}}]["ChromaticInvariant"]

A182517

seq=Table[GraphData[{"Grid",{n,n}},"ChromaticInvariant"],{n,10}]

FindSequenceFunction[Take[l,{2,4}]]

Grid k×m×n

Entity["Graph",{"Grid",{k,m,n}}]["ChromaticInvariant"]

Grid n×n×n

Entity["Graph",{"Grid",{n,n,n}}]["ChromaticInvariant"]

A295173

seq=Table[GraphData[{"Grid",{n,n,n}},"ChromaticInvariant"],{n,10}]

HalvedCube

A295174

seq=Table[GraphData[{"HalvedCube",n},"ChromaticInvariant"],{n,10}]

FindSequenceFunction[Take[l,{1,5}]][n-1]

FindSequenceFunction[Take[l,{2,5}]][n-1]

Hanoi

A295175

seq=Table[GraphData[{"Hanoi",n},"ChromaticInvariant"],{n,5}]

Helm

seq=Table[GraphData[{"Helm",n},"ChromaticInvariant"],{n,3,20}]

Hypercube

Entity["Graph",{"Hypercube",n}]["ChromaticInvariant"]

A295176

seq=Table[GraphData[{"Hypercube",n},"ChromaticInvariant"],{n,0,10}]

FindSequenceFunction[Take[l,{2,4}]][n-1]//Simplify

Keller

Entity["Graph",{"Keller",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Keller",n},"ChromaticInvariant"],{n,5}]

King n×n

A295177

seq=Table[GraphData[{"King",{n,n}},"ChromaticInvariant"],{n,10}]

Knight m×n

Entity["Graph",{"Knight",{m,n}}]["ChromaticInvariant"]

Knight n×n

Entity["Graph",{"Knight",{n,n}}]["ChromaticInvariant"]

A295178

seq=Table[GraphData[{"Knight",{n,n}},"ChromaticInvariant"],{n,10}]

Ladder

Entity["Graph",{"Ladder",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Ladder",n},"ChromaticInvariant"],{n,20}]

LadderRung

seq=Table[GraphData[{"LadderRung",n},"ChromaticInvariant"],{n,20}]

MengerSponge

seq=Table[GraphData[{"MengerSponge",n},"ChromaticInvariant"],{n,3}]

MoebiusLadder

Entity["Graph",{"MoebiusLadder",n}]["ChromaticInvariant"]

A000325

seq=Table[GraphData[{"MoebiusLadder",n},"ChromaticInvariant"],{n,3,25}]

FindSequenceFunction[seq,n-2]

Mycielski

Entity["Graph",{"Mycielski",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Mycielski",n},"ChromaticInvariant"],{n,10}]

Odd

Entity["Graph",{"Odd",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Odd",n},"ChromaticInvariant"],{n,5}]

Pan

seq=Table[GraphData[{"Pan",n},"ChromaticInvariant"],{n,3,20}]

Path

Entity["Graph",{"Path",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Path",n},"ChromaticInvariant"],{n,20}]

PathComplement

A302978

seq=Table[GraphData[{"PathComplement",n},"ChromaticInvariant"],{n,20}]

Join[{1,2},Table[Sum[Binomial[n-k,k](((-1))^k)(n-k-2)!,{k,0,Floor[n/2]}],{n,3,20}]]

Sum[Binomial[n-k,k](((-1))^k)(n-k-2)!,{k,0,Floor[n/2]}]//FullSimplify

Join[{1,2},Table[Gamma[-1+n] HypergeometricPFQ[{(1/2)-(n/2),-(n/2)},{2-n,-n},-4],{n,3,20}]]

seq=Table[Gamma[-1+n] HypergeometricPFQ[{(1/2)-(n/2),-(n/2)},{2-n,-n},-4],{n,3,50}];

FindSequenceFunction[seq,n-2]//Head//Timing

Join[{1,2},RecurrenceTable[{-n a[n]+(3+2 n) a[1+n]+(-5-n) a[2+n]+a[3+n]==0,a[1]==-1,a[2]==0,a[3]==1},a,{n,20}]]

Solve[-n a[n]+(3+2 n) a[1+n]+(-5-n) a[2+n]+a[3+n]==0,a[n]]//Simplify

FindLinearRecurrence[seq]//Head//Timing

FindGeneratingFunction[seq,x]//Head//Timing

PermutationStar

seq=Table[GraphData[{"PermutationStar",n},"ChromaticInvariant"],{n,6}]

Prism

Entity["Graph",{"Prism",n}]["ChromaticInvariant"]

A000295

seq=Table[GraphData[{"Prism",n},"ChromaticInvariant"],{n,3,25}]

FindSequenceFunction[seq,n-2]

Table[2^n-n-1,{n,20}]

LinearRecurrence[{4,-5,2},{0,0,1},20]

Queen n×n

A295187

seq=Table[GraphData[{"Queen",{n,n}},"ChromaticInvariant"],{n,10}]

Rook n×n

A295184

seq=Table[GraphData[{"Rook",{n,n}},"ChromaticInvariant"],{n,10}]

FindSequenceFunction[Take[l,{2,4}]][n-1]//Simplify

RookComplement n×n

A295186

seq=Table[GraphData[{"RookComplement",{n,n}},"ChromaticInvariant"],{n,10}]

FindSequenceFunction[Take[l,{2,4}]][n-1]//Simplify

SierpinskiCarpet

seq=Table[GraphData[{"SierpinskiCarpet",n},"ChromaticInvariant"],{n,4}]

SierpinskiSieve

A295189

seq=Table[GraphData[{"SierpinskiSieve",n},"ChromaticInvariant"],{n,5}]

SierpinskiTetrahedron

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"ChromaticInvariant"],{n,5}]

Star

Entity["Graph",{"Star",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Star",n},"ChromaticInvariant"],{n,20}]

Sun

A000142

seq=Table[GraphData[{"Sun",n},"ChromaticInvariant"],{n,3,20}]

FindSequenceFunction[seq,n-2]

Sunlet

seq=Table[GraphData[{"Sunlet",n},"ChromaticInvariant"],{n,3,20}]

Tetrahedral

seq=Table[GraphData[{"Tetrahedral",n},"ChromaticInvariant"],{n,6,10}]

TorusGrid n×n

A295191

seq=Table[GraphData[{"TorusGrid",{n,n}},"ChromaticInvariant"],{n,3,10}]

Transposition

seq=Table[GraphData[{"Transposition",n},"ChromaticInvariant"],{n,6}]

Triangular

A295192

seq=Table[GraphData[{"Triangular",n},"ChromaticInvariant"],{n,2,10}]

TriangularGrid

A295190

seq=Table[GraphData[{"TriangularGrid",n},"ChromaticInvariant"],{n,0,10}]

seq={1,1,1,5,97,6739,1611097,1295101469,3449859538455,30155591559236245,859063676925680110319,79361177641450830904290293};

FindLinearRecurrence[DeleteMissing@Drop[seq,3]]//Head//Timing

FindSequenceFunction[DeleteMissing@Drop[seq,3],n-3]//Head//Timing

FindGeneratingFunction[DeleteMissing@seq,x]//Head//Timing

TriangularHoneycombAcuteKnight

Computed up to n=9, set to 0 above since for n>=3, chromatic polys are of the form (((-2+x))^(...)) (((-1+x))^6) (x^3)

seq=Table[GraphData[{"TriangularHoneycombAcuteKnight",n},"ChromaticInvariant"],{n,20}]

TriangularHoneycombObtuseKnight

A295194

seq=Table[GraphData[{"TriangularHoneycombObtuseKnight",n},"ChromaticInvariant"],{n,20}]

TriangularHoneycombQueen

A295195

seq=Table[GraphData[{"TriangularHoneycombQueen",n},"ChromaticInvariant"],{n,10}]

TriangularHoneycombRook

seq=Table[GraphData[{"TriangularHoneycombRook",n},"ChromaticInvariant"],{n,10}]

Web

seq=Table[GraphData[{"Web",n},"ChromaticInvariant"],{n,3,20}]

Wheel

Entity["Graph",{"Wheel",n}]["ChromaticInvariant"]

seq=Table[GraphData[{"Wheel",n},"ChromaticInvariant"],{n,4,20}]

FindSequenceFunction[seq,n-3]

WheelComplement

seq=Table[GraphData[{"WheelComplement",n},"ChromaticInvariant"],{n,4,20}]

Do[Print[{k,FindLinearRecurrence[DeleteMissing@Drop[seq,k]]//Head//Timing}],{k,0,5}]

FindSequenceFunction[-DeleteMissing@Drop[seq,2],n-2]//Head//Timing

FindGeneratingFunction[-DeleteMissing@Drop[seq,2],x]//Head//Timing

WhiteBishop n×n

A295217

seq=Table[GraphData[{"WhiteBishop",{n,n}},"ChromaticInvariant"],{n,2,10}]

Tests

Complement@@(GraphData[#,"Missing"]&/@{"ChromaticInvariant","ChromaticPolynomial"})

Select[GraphData["ChromaticPolynomial","Defined"],GraphData[#,"ChromaticInvariant"]=!=(-1)^GraphData[#,"V"]Derivative[1][GraphData[#,"ChromaticPolynomial"]][1]&]