# Graph Coloring based on neighboring vertices? Cellular Automata

I would like to apply a majority rule cellular automata to graphs. Specifically, I would like to take a graph as input, and then define two functions, InitialColoring[graph] and MajorityRule[graph]. Suppose the set of colors is some given finite list.

InitialColoring[graph] uses some rule (such as randomly assigning colors to each vertex). MajorityRule[graph] this "updates" the coloring for a given graph by getting the neighbors of each vertex, checking which color has the majority, and then coloring the majority color. For simplicity, let's assume the set of colors only has two colors, and if there is a tie, the vertex keeps its current color.

My thoughts: Make a loop ranging over vertices, get neighbors, get colors, count colors, apply. I am very new to Mathematica so I am not sure how to implement this. Any suggestions on this approach or a better method to accomplish the same goal?

Also note: I want to apply cellular automata to graphs (specifically CayleyGraphs), not just the integer lattice so the built-in CellularAutomata function doesn't seem to help much.

EDIT: EXAMPLE:

Suppose we have the graph shown in the upper left corner in the figure below. We want to apply the rule that a vertex's color is determined by the color of the majority of its neighbors (if there is a tie, it keeps its color). Below shows an example of the progression of this automata. This outlines what I want: 1) enter a graph with an initial coloring 2) apply a rule (shown through progression of arrows) that outputs a new graph (or perhaps two functions, one that outputs the graph data, and one that outputs the color data... then these are combined in some way... I'm not sure which would be easier/more efficient to implement).

I am lost as to how to implement this, although the algorithm is pretty easy. In fact, focusing to the case where we only have two colors and the majority rule would suffice.

EDIT 2: Further Details Updating should be synchronous, i.e., when we go from one time to the next, it should look like we updated every vertex all at once. Otherwise, we could get unwanted colorings due to intermediate updates in sequential updating. For example, in the example above, if we colored the top vertex first, and then proceeded, the rightmost vertex would stay blue the next generation instead of changing to red.

Also, when checking for the vertex's color, the vertex itself should only be considered in the event of a tie, i.e., it is not considered one of its neighbors unless there is a loop (we don't assume graphs are implicitly reflexive).

• Would you please try to add a concrete example of what you describe? Jan 20, 2015 at 21:21
• There is closely related demonstration: Four-Color Outer Median Cellular Automata on Graphs Jan 20, 2015 at 23:14
• Shouldn't the update stop at step 3?
– kglr
Jan 22, 2015 at 0:00

More is better, other variation:

upDateColor[g_] :=
Block[{color, vlist, c},
color = Association[PropertyValue[g, VertexStyle]];
vlist = VertexList[g];
SetProperty[g,
VertexStyle ->
Table[v ->
If[Length[c = Commonest[color /@ AdjacencyList[g, v]]] == 1,
First[c], color[v]], {v, vlist}]]
]


example:

g = PetersenGraph[5,
2, {VertexSize -> Large, ImageSize -> 200,
VertexLabels -> Placed["Name", Center],
VertexStyle ->
Thread[Range -> RandomChoice[{Red, Blue, Green}, {10}]]}];

Row@Most[FixedPointList[upDateColor, g]] in case of repeating sequence, you could define a function like below to detect sequence pattern (this one only detect result one above):

iFixedPointList[func_, g_, n___] :=
Block[{i},
i = g;
FixedPointList[func, g, n,
SameTest -> (SameQ[i, #2] || (i = #1; SameQ[#1, #2]) &)]
]

SeedRandom; g =
PetersenGraph[5,
2, {VertexSize -> Large, ImageSize -> 200,
VertexLabels -> Placed["Name", Center],
VertexStyle ->

iFixedPointList[upDateColor, g] // Length


4

FixedPointList[upDateColor, g, 6] // Length


7

• Could you provide more information on how to use this...? Feb 3, 2015 at 13:10
• @user2154420 just same as others. Feb 3, 2015 at 14:03
• Is this guaranteed to halt? I ran it, changing {Red, Blue, Green} to {Red, Blue}, and there hasn't been any output... still calculating away. Feb 3, 2015 at 14:09
• @user2154420 I didn't think of that... but you're correct I don't have any theoretical background that guarantee the convergence (seems not). Just add 3rd argument to FixedPointList to prevent infinite computations... Feb 3, 2015 at 14:24
• @user2154420 you could get those information by checking documentation : Slot (#) and Function (&) Feb 5, 2015 at 3:02

Update: The original post below computes the commonest color in the NeighborhoodGraph of a vertex v including the vertex v itself. To exclude a vertex in counting the colors in its neighborhood, we can use the following helper function:

ClearAll[newClrF];
newClrF = Module[{nc=#, oc=First@#, c1= Commonest[Rest@#][], c2= Quiet@Commonest[Rest@#, 2]},
If[And[Length@c2 > 1, Equal @@ (Count[Rest@nc, #] & /@ c2)], oc, c1]] &;


and modify reColorF1 and reColorF2:

ClearAll[reColorF1B, reColorF2B];
reColorF1B = Module[{g = #1, vl = VertexList[#1], cl, ncl},
ncl = (neighborColorsF[g, #1] &) /@ vl; cl = newClrF /@ ncl;
MapThread[(PropertyValue[{g, #}, VertexStyle] = #2) &, {vl, cl}]; g] &;

reColorF2B = Module[{g = #1, vl = VertexList[#1], cl, ncl},
ncl = (neighborColorsF[g, #1] &) /@ vl; cl = newClrF /@ ncl;
SetProperty[g, VertexStyle -> Thread[vl -> cl]]] &;


Using the same examples as in the previous post:

Grid[Most@FixedPointList[reColorF1B, #, 5] & /@ {g1, g2}] Another example:

g3 = SetProperty[g, {VertexStyle ->
Thread[Range -> {Red, Blue, Green, Orange, Red, Green, Orange, Red, Red, Orange}],
VertexSize -> Large, ImageSize -> 100}];
Grid[Most@FixedPointList[#, g3, 9] & /@ {reColorF1, reColorF1B}] Previous post: In the following, color counts in the neighborhood of a vertex v include the color of vertex v.

ClearAll[neighborsF, neighborColorsF, commonestColorF, reColorF1, reColorF2];
neighborsF = Function[{g, v}, VertexList[NeighborhoodGraph[g, v]]];
neighborColorsF = Function[{g, v}, PropertyValue[{g, #}, VertexStyle] & /@ neighborsF[g, v]];
commonestColorF = Function[{g, vl}, (Commonest[neighborColorsF[g, #]][]) & /@ vl];


Using the above helper functions, define

reColorF1 =  Module[{g = #, vl = VertexList @ #, cl = commonestColorF[#, VertexList @ #]},
MapThread[(PropertyValue[{g, #}, VertexStyle] = #2) &, {vl, cl}]; g] &;


Alternatively, you can use SetProperty to change the vertex colors:

reColorF2 =  Module[{g = #, vl = VertexList @ #, cl = commonestColorF[#, VertexList @ #]},
SetProperty[g, VertexStyle -> Thread[vl -> cl]]] &;


Examples:

g = PetersenGraph[5, 2];
g1 = SetProperty[g, { VertexSize -> Large, ImageSize -> 200,
VertexLabels -> Placed["Name", Center],
VertexStyle -> Thread[Range -> RandomChoice[{Red, Blue, Green}, {10}]]}];
g2 = SetProperty[g, { VertexSize -> Large, ImageSize -> 200,
VertexLabels -> Placed["Name", Center],
VertexStyle -> Thread[Range -> RandomChoice[{Red, Blue, Green}, {10}]]}];

Grid[Most@FixedPointList[reColorF1, #, 5] & /@ {g1, g2}] Grid[Most@FixedPointList[reColorF2, #, 5] & /@ {g1, g2}]
(* same picture *)


Note: Breaking ties in favor of current color:

OP's requirement

"if there is a tie, the vertex keeps its current color"

is satisfied, i.e., both functions above break ties in favor of the current own color, because

1. VertexList[NeighborhoodGraph[g, x]] lists x as the first vertex, and
2. Commonest[list] breaks the ties based on the order the elements appear in list.
• Very nice, +1, but is this "if there is a tie, the vertex keeps its current color" satisfied? Don't you just choose 1st color in the list of ties? Jan 21, 2015 at 1:50
• @Vitaly, you are right, thank you. Will update with a fix for the tie-breaking problem.
– kglr
Jan 21, 2015 at 2:00
• @Vitaly, come to think of it, we don't need a fix. The function recolorF breaks ties in favor of the current own color because (1) VertexList[NeighborhoodGraph[g1, v]] lists v as the first vertex and (2) Commonest[list] breaks the ties based on the order the elements appear in list.
– kglr
Jan 21, 2015 at 2:21
• for g1, lower left red should turn green? Jan 21, 2015 at 14:55
• @user2154420, updating is "synchronous" in both versions.
– kglr
Jan 22, 2015 at 0:02

First, let's whip up a random graph:

n = RandomInteger[{10, 15}];
m = RandomInteger[{Floor[n^2/20], n (n - 1)/2}];
G = RandomGraph[{n, m}];
For[i = 1, i <= n, i++,
chi[0, i] = {Red, Blue}[[RandomInteger[] + 1]]
];
Graph[G, VertexStyle -> Table[i -> chi[0, i], {i, 1, n}]] The coloring at step k will be denoted chi[k,i], where i indicates a vertex. I am going to start now assuming that some graph object G is given, but that it is not necessarily of the above form, so the vertex i might not be an integer:

VX = VertexList[G];
n = Length[VX];
EX = EdgeList[G];
m = Length[EX];


Obviously if you generate G as above, some of that is unnecessary.

Since the underlying graph is static, it's easiest to just hash out the neighborhoods of each vertex quickly:

For[i = 1, i <= n, i++,
NBHD[i] = Select[EX, #[] == i || #[] == i &];
NBHD[i] = Complement[Union @@ (List @@ # & /@ NBHD[i]), {i}];
]


From there, we can define kmax steps of this process as:

kmax = 10;
For[k = 1, k <= kmax, k++,
For[i = 1, i <= n, i++,
COL = Commonest[chi[k - 1, #] & /@ NBHD[VX[[i]]]];
chi[k, i] =
Which[
Length[COL] == 1, COL[],
MemberQ[COL, chi[k - 1, i]], chi[k - 1, i],
True, COL[[RandomInteger[{1, Length[COL]}]]]
];
];
];


I've made the choice that if there is a tie among neighbors, if that tie includes the current color, the vertex says the same color. If some vertex has a tie among neighbors that does not include its current color, it changes randomly to one of those most popular colors. (That's what's happening in the Which conditional.)

You can display the results with:

Manipulate[
Graph[G, VertexStyle -> Table[i -> chi[k, i], {i, 1, n}]],
{k, 0, kmax, 1}] I'm sure there are other/different/better ways to do parts of this, but I think this gets you going the way you want. I hope it is also flexible enough if your G has a non-integer vertex set or some other issue. And so long as you define chi[0,i] for all i using some valid color, you get what you need out. This should be fairly flexible in such regards.

You can reproduce the "usual" automata using GridGraph like this:

G = GridGraph[{10, 10}];
For[i = 1, i <= n, i++,
chi[0, i] = {Red, Blue}[[Mod[i, 2] + 1]]
];


I've used this particular coloring (not random) to get some interesting behavior out of the automaton.

Update

To achieve the tie-breaking rule where ties result in no color change, just swap out:

     If[
Length[COL] == 1, COL[], chi[k - 1, i]
];


for the Which conditional above. Note that this will produce possibly counter-intuitive behavior, like a green node with 10 red neighbors and 10 blue neighbors remaining green without any green neighbors.

• I think there is an error somewhere. Initial graph: i.imgur.com/M7e8D4k.jpg After one iteration: i.imgur.com/3vfNnBj.jpg I'll add an edit to my question for further clarification, but when applying the rule, the new graph should look like what would happen if we updated every vertex at the same time (synchronous updating) instead of one, then another (sequential updating), since vertex colors could change based in intermediate updates. I'll add further clarification to the majority rule. We should only consider a vertex itself when updating in the event of a tie. Jan 21, 2015 at 12:32
• "We should only consider a vertex itself when updating in the event of a tie." I don't understand. That is already addressed in my code and in my commentary. I also cannot reproduce this error you are introducing. Jan 21, 2015 at 22:37
• And thanks Sjoerd for the images, although my mind is having a bit of a paradoxical moment when a static image is used as the output of a random algorithm XD Jan 21, 2015 at 22:38
• No. It doesn't. chi[k,x] gives the coloring of vertex x at step k and this depends only on various values of chi[k-1,_]. It also does not include any vertex in its own list of neighbors. That's what Complement does. Jan 30, 2015 at 22:35
• I just want to say, it is very disappointing to have the questioner continue to insist this code is "insynchronous" [sic] and includes a vertex in its own neighbors. It has neither problem (and has not been modified), and I think others would appreciate it if the time one spends writing answers for you would be reciprocated by taking the time to read those answers more carefully. Feb 3, 2015 at 2:26