# How to solve and output the coloring problem in permutations and combinations?

Apply the four different colors red, yellow, green, and black to the areas in the figure shown below, with the requirement that adjacent areas cannot have the same color. How many different coloring methods are there?

We usually solve this kind of problem like this:

Label the areas in the figure with the notations A, B, C, D, E, as shown in the diagram above.

When B and D are the same color, there are 48 different coloring methods (4 x 3 x 2 x 1 x 2);

when B and D are different colors, there are 24 different coloring methods (4 x 3 x 2 x 1 x 1).

Therefore, there are a total of 72 different coloring methods (48 + 24).

My current problem is: How can I use Mathematica to identify each region in the image and, according to the requirements of the question, display the 72 different coloring results?

How to color it according to the requirements of the question?

The requirement is to generate 72 different colored images like the one shown below.

• I guess you already know that plaintext code should be posted instead of images. Commented Mar 21 at 10:54

im = Import["https://i.sstatic.net/0D8jy.png"];
color = ColorData[97, "ColorList"][[1 ;; 4]];
MorphologicalGraph[Binarize@ColorNegate@im, VertexLabels -> Automatic]
DualPlanarGraph[%, VertexLabels -> Automatic]
VertexDelete[%, {1, 2, 8, 5}]
List @@@ EdgeList[%] /. Thread[VertexList[%] -> #] & /@
Tuples[Range[4], 5];
Position[%, #] & /@ Select[%, Length[Cases[#, {x_, x_}]] == 0 &] //
Flatten;

MeanFilter[
Colorize[MorphologicalComponents[Binarize@im],
ColorRules -> {1 -> White,
Range[2, 6] -> color[[Tuples[Range[4], 5][[#]]]]]]},
ImageSize -> Tiny], 2] & /@ %;
Grid[Partition[%, 6]]


If the order of the colors does not matter there are in fact only 3 distinct colorings:

sameQ[a_, b__] :=
And @@ DuplicateFreeQ /@ (Transpose[{a, b}] // Union // Transpose)

im = Import["https://i.sstatic.net/0D8jy.png"];
color = ColorData[97, "ColorList"][[1 ;; 4]];
MorphologicalGraph[Binarize@ColorNegate@im, VertexLabels -> Automatic];
DualPlanarGraph[%, VertexLabels -> Automatic];
VertexDelete[%, {1, 2, 8, 5}];
List @@@ EdgeList[%] /. Thread[VertexList[%] -> #] & /@
DeleteDuplicates[Tuples[Range[4], 5], sameQ];
Position[%, #] & /@ Select[%, Length[Cases[#, {x_, x_}]] == 0 &] //
Flatten;

MeanFilter[
Colorize[MorphologicalComponents[Binarize@im],
ColorRules -> {1 -> White,
Range[2, 6] ->
color[[DeleteDuplicates[Tuples[Range[4], 5],
sameQ][[#]]]]]]}, ImageSize -> Tiny], 2] & /@ % // Row


sameQ[a_, b__] :=
And @@ DuplicateFreeQ /@ (Transpose[{a, b}] // Union // Transpose)

im = Import["https://i.sstatic.net/0D8jy.png"];
color = ColorData[97, "ColorList"][[1 ;; 4]];
MorphologicalGraph[Binarize@ColorNegate@im, VertexLabels -> Automatic];
DualPlanarGraph[%, VertexLabels -> Automatic];
VertexDelete[%, {1, 2, 8, 5}];
List @@@ EdgeList[%] /. Thread[VertexList[%] -> #] & /@
Tuples[Range[4], 5];
Position[%, #] & /@ Select[%, Length[Cases[#, {x_, x_}]] == 0 &] //
Flatten;
Gather[Tuples[Range[4], 5][[#]] & /@ %, sameQ];

(MeanFilter[
Colorize[MorphologicalComponents[Binarize@im],
ColorRules -> {1 -> White,

• Select[%, Length[Cases[#, {x_, x_}]] == 0 &] - it selects cases where there is no item with the same color. Commented Mar 22 at 6:57
• @csn899 I added the code for the three colorings. Function sameQ is used do delete duplicates that have the same coloring structure. Commented Mar 23 at 12:56
• @csn899 And what are you trying to do yourself? Cannot you do such a trivial task? You can use Gather to separate to groups by sameQ. Commented Mar 24 at 9:49