大人の塗り絵簡易版。Mathematica in Action http://www.amazon.co.jp/dp/0387753664?tag=inquisitor-22 のコードは動かず。参考：https://www.wolfram.com/mathematica/new-in-10/entity-based-geocomputation/find-a-four-coloring-of-a-map-of-europe.html

four-coloring.m

map = Import["http://mathforum.org/wagon/fall97/images/5colormap.gif"];

matrix = MorphologicalComponents[map];

vars = Flatten[Map[{p[#], q[#]} &, Rest[Union[Flatten[matrix]]]]];

f[r_] := Map[If[Length[Union[#]] > 2, Sort[Select[#, Positive]], Nothing] &,
   Partition[r, 4, 1]];

neighbours = Union[Flatten[Map[f, Join[matrix, Transpose[matrix]]], 1]];

eqns = Apply[And,
   Map[BooleanConvert[Or[
       Xor[p[#[[1]]], p[#[[2]]]],
       Xor[q[#[[1]]], q[#[[2]]]]], "CNF"] &, neighbours]];

sol = FindInstance[eqns, vars, Booleans];

colors = {
   {True, True} -> RGBColor["#ea5415"],
   {True, False} -> RGBColor["#1d7a21"],
   {False, True} -> RGBColor["#005192"],
   {False, False} -> RGBColor["#ffdf00"]};

cTable = Table[i -> {p[i], q[i]} /. sol[[1]] /. colors, {i, 2, Length[vars]/2}];

ArrayPlot[matrix,
 Frame -> False,
 ColorRules -> Append[cTable, 0 -> Black]]