# Find a Four-Coloring of a Map of Europe

Find the neighbors of each European country.

 In[1]:= Xcountries = EntityList[EntityClass["Country", "EuropeSovereign"]]; countryneighbors = { #, Intersection[CountryData[#, "BorderingCountries"], countries] } & /@ countries;

These are the neighbors of Austria.

 In[2]:= XFirst[countryneighbors]
 Out[2]=

Encode the four possible colors as two Booleans per country.

 In[3]:= Xcolorcode = { {False, False} -> Red, {False, True} -> Blue, {True, False} -> Green, {True, True} -> Yellow};
 In[4]:= Xcountrybooleans = # -> {x[#], y[#]} & /@ countries;

Express the condition that all pairs of bordering countries have different colors as a logical expression.

 In[5]:= Xeqs = And @@ (Flatten[ Function[{country, neighbors}, BooleanConvert[ Xor[x[country], x[#]] || Xor[y[country], y[#]], "CNF" ] & /@ neighbors] @@@ countryneighbors]);

Compute a solution to the four-color problem.

 In[6]:= Xsolution = First[FindInstance[eqs, Flatten[Last /@ countrybooleans], Booleans]];

Form the coloring.

 In[7]:= Xcoloring = countrybooleans /. solution /. colorcode
 Out[7]=

Color each country according to the coloring found.

 In[8]:= XGeoGraphics[{EdgeForm[ Directive[Thin, Black]], {GeoStyling[#2], Tooltip[Polygon[#1], #1[[2]]]} & @@@ coloring}]
 Out[8]=

## Mathematica

Questions? Comments? Contact a Wolfram expert »