1
$\begingroup$

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?

enter image description here

We usually solve this kind of problem like this:

enter image description here

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?

enter image description here

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.

enter image description here

$\endgroup$
1
  • 2
    $\begingroup$ I guess you already know that plaintext code should be posted instead of images. $\endgroup$ Commented Mar 21 at 10:54

1 Answer 1

6
$\begingroup$
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, 
       Splice[Thread[
         Range[2, 6] -> color[[Tuples[Range[4], 5][[#]]]]]]}, 
     ImageSize -> Tiny], 2] & /@ %;
Grid[Partition[%, 6]]

enter image description here

enter image description here

enter image description here

enter image description here

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, 
       Splice[Thread[
         Range[2, 6] -> 
          color[[DeleteDuplicates[Tuples[Range[4], 5], 
              sameQ][[#]]]]]]}, ImageSize -> Tiny], 2] & /@ % // Row

enter image description here

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, 
          Splice[Thread[Range[2, 6] -> color[[#]]]]}, 
        ImageSize -> Tiny], 2] & /@ #) & /@ %;

Column[Grid[Partition[#, 6]] & /@ %, Frame -> All]

enter image description here

$\endgroup$
8
  • $\begingroup$ Which code reflects the rule that adjacent areas cannot have the same color? $\endgroup$
    – csn899
    Commented Mar 22 at 1:00
  • 1
    $\begingroup$ Select[%, Length[Cases[#, {x_, x_}]] == 0 &] - it selects cases where there is no item with the same color. $\endgroup$ Commented Mar 22 at 6:57
  • $\begingroup$ How were the following three figures independently obtained? $\endgroup$
    – csn899
    Commented Mar 23 at 1:47
  • 1
    $\begingroup$ @csn899 I added the code for the three colorings. Function sameQ is used do delete duplicates that have the same coloring structure. $\endgroup$ Commented Mar 23 at 12:56
  • 1
    $\begingroup$ @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. $\endgroup$ Commented Mar 24 at 9:49

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.