# ヨーロッパの地図の4色を求める

ヨーロッパ各国の隣接国を求める．

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

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

4つの色を1つの国につき2つのブール値として符号化する．

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

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

4色問題の解を計算する．

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

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

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

## Mathematica

Questions? Comments? Contact a Wolfram expert »