Mathematics Stack Exchange is a question and answer site for people studying math at any level and professionals in related fields. It only takes a minute to sign up.
Sign up to join this community
For each of the trees, how many different ways are there of coloring the vertices with k colors such that adjacent vertices are colored with different colors and so that two colorings of the graph are considered different if there is no rearrangement of the vertices so that they look the same?
i dont understand the last bit
A Google search will reveal that these graph colorings are counted by so-called orbital chromatic polynomials (as opposed to ordinary chromatic polynomials). These count proper colorings under the action of the automorphism group of the graph.
The algorithm to compute these is documented e.g. at Peter Cameron's blog. This is really quite straightforward supposing that the number of automorphisms of the graph is of a reasonable order, e.g. linear in the number of vertices as in the case of a bracelet. What we do here is to apply Burnside, iterating over all automorphisms and computing the number of proper colorings that they fix and averaging the results. To do this we factorize the automorphisms into cycles, on which the color has to be constant. Therefore we have no contribution if a cycle of the factored automorphism contains two vertices linked by an edge since these may not be monochrome in a proper coloring. Otherwise we shrink all the cycles to vertices, creating a reduced graph, where two new vertices are adjacent if there existed an edge between the vertices on the cycles in the source graph. The colorings fixed by this automorphism are then counted by the ordinary chromatic polynomial of the reduced graph. Hence the orbital chromatic polynomial is obtained by averaging these over the number of automorphisms.
It is not difficult to implement this in Maple, where the goal was to get a functioning program to answer the question, which may of course be optimized in many ways. We decided on a simple data structure representing graphs and their automorphism group by a list of the edges, the number of vertices, and the permutations from the group. We use these as inputs to Burnside where we carry out the iteration that we described, obtaining the OCP. Numbering the four trees from left to right we thus obtain for the first tree,
$$1/8\,{k}^{7}-1/2\,{k}^{6}+1/4\,{k}^{2}-1/4\,{k}^{4} \\-3/8\,{k}^{3}+3/4\,{k}^{5},$$
for the second one,
$$1/6\,{k}^{7}-{k}^{6}+3\,{k}^{5}-16/3\,{k}^{4} \\+{\frac {35\,{k}^{3}}{6}}-11/3\,{k}^{2}+k$$
for the third one
$$1/24\,{k}^{7}-1/6\,{k}^{5}+1/12\,{k}^{4} \\+1/8\,{k}^{3}-1/12\,{k}^{2}$$
and for the last one,
$$1/12\,{k}^{7}-1/6\,{k}^{6}+1/6\,{k}^{4}-1/12\,{k}^{3}.$$
The admissible colorings under the action of the automorphism group of the tree are then computed by instantiating $k$ to the number of colors.
With these trees having a reasonable number of automorphisms we can check the correctness of the OCP by enumerating colorings with few colors. This was done and may be seen in the attached Maple code. E.g. for tree number three the enumeration routine produces
$$0, 2, 60, 540, 2800, 10500,\ldots $$
which is indeed given by the polynomial listed above.
Similarly the question of proper colorings of bracelets (dihedral symmetry) recently appeared at this MSE link. This forms the second sanity check where for example we obtain matching OCPs from the cited link and the present document. E.g. for a bracelet on five beads we obtain by both methods
$$1/10\,{k}^{5}-1/2\,{k}^{4}+{k}^{3}-{k}^{2}+2/5\,k$$
and for six beads,
$$1/12\,{k}^{6}-1/2\,{k}^{5}+3/2\,{k}^{4}-7/3\,{k}^{3} +{\frac {23\,{k}^{2}}{12}}-2/3\,k.$$
We now present the Maple code which uses only one routine from a library of Polya Enumeration code while the rest translates the specification of the algorithm with little auxiliary effort required.
with(GraphTheory);
with(combinat);
T1 :=
proc()
option remember;
return
[7,
{{1,2}, {1, 3}, {2, 4}, {2, 5},
{3, 6}, {3, 7}},
[[1,2,3,4,5,6,7],
[1,2,3,5,4,6,7],
[1,2,3,4,5,7,6],
[1,2,3,5,4,7,6],
[1,3,2,6,7,4,5],
[1,3,2,7,6,4,5],
[1,3,2,6,7,5,4],
[1,3,2,7,6,5,4]]];
end;
T2 :=
proc()
option remember;
local automs, src, perm;
src := [[2,3], [4,5], [6,7]];
automs := [];
for perm in permute(3) do
automs :=
[op(automs),
[1,
seq(op(src[perm[q]]),
q=1..3)]];
od;
return
[7,
{{1, 2}, {1, 4}, {1, 6},
{2, 3}, {4, 5}, {6, 7}},
automs];
end;
T3 :=
proc()
option remember;
local automs, perm;
automs := [];
for perm in permute(4) do
automs :=
[op(automs),
[1,2,3, seq(perm[q]+3, q=1..4)]];
od;
return
[7,
{{1, 2}, {2, 3},
{1, 4}, {1, 5}, {1, 6}, {1, 7}},
automs];
end;
T4 :=
proc()
option remember;
local automs, perm1, perm2;
automs := [];
for perm1 in permute(2) do
for perm2 in permute(3) do
automs :=
[op(automs),
[1, 2,
seq(perm1[q]+2, q=1..2),
seq(perm2[q]+4, q=1..3)]];
od;
od;
return
[7,
{{1, 2}, {1, 5}, {1, 6}, {1, 7},
{2, 3}, {2, 4}},
automs];
end;
BRACELET :=
proc(n)
option remember;
local automs, rot, shft, edges;
if n=1 then return [1, {}, [[1]]] fi;
automs := [];
for rot to n do
shft :=
[seq(q, q=rot..n), seq(q, q=1..rot-1)];
automs :=
[op(automs),
shft, [seq(shft[n-q], q=0..n-1)]];
od;
edges :=
{{n, 1},
seq({q, q+1}, q=1..n-1)};
return [n, edges, automs];
end;
pet_autom2cyclesA :=
proc(src, aut)
local numa, numsubs;
local marks, pos, cycs, data, item, cpos, clen;
numsubs := [seq(src[k]=k, k=1..nops(src))];
numa := subs(numsubs, aut);
marks := Array([seq(true, pos=1..nops(aut))]);
cycs := []; pos := 1; data := [];
while pos <= nops(aut) do
if marks[pos] then
clen := 0; item := []; cpos := pos;
while marks[cpos] do
marks[cpos] := false;
item := [op(item), aut[cpos]];
cpos := numa[cpos];
clen := clen+1;
od;
cycs := [op(cycs), clen];
data := [op(data), item];
fi;
pos := pos+1;
od;
return [data, mul(a[cycs[k]], k=1..nops(cycs))];
end;
OCP :=
proc(tdata)
option remember;
local n, edges, automs, autom, src,
cycs, cidx, ccount, admit, edg,
potedg, rededgs, cdx1, cdx2, c1, c2, redG, ocp;
n := tdata[1];
edges := tdata[2];
automs := tdata[3];
src := [seq(q, q=1..n)];
ocp := 0;
for autom in automs do
cycs := pet_autom2cyclesA(src, autom)[1];
ccount := nops(cycs);
admit := true; cidx := 1;
while admit and cidx <= ccount do
for edg in choose(cycs[cidx], 2) do
if {edg[1], edg[2]} in
edges then
admit := false;
break;
fi;
od;
cidx := cidx + 1;
od;
if admit then
rededgs := {};
for cdx1 to ccount do
for cdx2 from cdx1+1 to ccount do
c1 := cycs[cdx1]; c2 := cycs[cdx2];
potedg :=
{seq(seq({c1[p], c2[q]},
p=1..nops(c1)), q=1..nops(c2))};
if edges intersect potedg <> {} then
rededgs :=
{op(rededgs), {cdx1, cdx2}};
fi;
od;
od;
redG :=
Graph([seq(q, q=1..ccount)], rededgs);
ocp := ocp +
ChromaticPolynomial(redG, 'k');
fi;
od;
expand(ocp/nops(automs));
end;
X := (tdata, kval) -> subs('k'=kval, OCP(tdata));
ENUM :=
proc(tdata, k)
option remember;
local n, edges, edg, admit, automs, autom,
orbits, orbit, idx, cols;
n := tdata[1];
edges := tdata[2];
automs := tdata[3];
if k=1 then
return `if`(nops(edges)=0, 1, 0);
fi;
orbits := table();
for idx from k^n to 2*k^n-1 do
cols := convert(idx, base, k)[1..n];
admit := true;
for edg in edges do
if cols[op(1, edg)] = cols[op(2, edg)]
then
admit := false;
break;
fi;
od;
if not admit then next fi;
orbit := [];
for autom in automs do
orbit :=
[op(orbit),
[seq(cols[autom[q]], q=1..n)]];
od;
orbits[sort(orbit)[1]] := 1;
od;
numelems(orbits);
end;
For example in the first graph the coloring:
$A\\B-C\\D\\E-F\\G$
is "the same" that the coloring:
$G\\E-F\\D\\B-C\\A$
