This question already has an answer here:

I'm still wrestling with the following problem; I' m attempting to apply the Four Color Theorem to the map of Florida; USA. The attribute "BorderingCounties" doesn't work for Alachua County (but, it works for all other counties in Florida):

AdministrativeDivisionData[Entity["AdministrativeDivision", {"AlachuaCounty", "Florida", "UnitedStates"}], "BorderingCounties"]

gives: "Missing["UnknownEntity", {"AdministrativeDivision", {"AlachuaCounty", "Florida", "UnitedStates"}}]. Next; build the following set containing of all the counties in Florida:

    counties = 
   EntityClass["AdministrativeDivision", "USCountiesFlorida"]];

Here is a list of the bordering counties for each county of Florida (except for Alachua County); and including some counties located in the States of Alabama and Georgia :

    borderingcounties = 
  AdministrativeDivisionData[#, "BorderingCounties"] & /@ counties;

Since evaluating;


gives: "Missing["UnknownEntity", {"AdministrativeDivision", {"AlachuaCounty", "Florida", "UnitedStates"}}]" ; we do the following "patchup":

    borderingcounties[[1]] = 
 Table[counties[[i]], {i, {4, 12, 20, 37, 41, 54, 63}}]

If you now evaluate:


you'll see that it now contains the desired counties.

Here is a map showing all the bordering counties. Notice that the map includes some counties located in Alabama and Georgia :

   Directive[Opacity[0.05], Yellow, EdgeForm[Black]]], 
  Polygon[borderingcounties], GeoStyling[]}, 
 GeoProjection -> "Equirectangular", Frame -> True]

Now build the following set that contains: each county in Florida; together with the corresponding bordering counties associated to each county; located exclusively in Florida :

    neighbors = 
    Intersection[borderingcounties[[i]], counties]}, {i, 1, 

(** Express the condition that all pairs of bordering countries have different colors as a logical expression: **)

 eqs = And @@ (Flatten[Function[{c, n}, BooleanConvert[Xor[x[c], x[#]] || Xor[y[c], y[#]], "CNF"] & /@ n] @@@ neighbors]);

(** Compute a solution to the four - color problem: **)

    solution = 
    FindInstance[eqs, Union[Cases[eqs, _x | _y, \[Infinity]]], 
   Flatten[{x[#] -> True, y[#] -> True} & /@ 
     Flatten[Cases[neighbors, {_, {}}]]]];

and the above evaluation is where I get in trouble since I get the following two warning messages after "solution" above is evaluated:

"First::nofirst:{}has zero length and no first element." and

"Join::heads: "Heads First and List at positions 1 and 2 are expected to be the same."

And since the evaluation of solution fails; the following three lines of code below also fail after they are evaluated:

(** Encode four colors as Boolean variables x and y: **)

 toColor[tf_] := <|{False, False} -> Red, {False, True} -> Blue, {True, False} -> Green, {True, True} -> Yellow|>[tf]

(** Form the coloring: **)

    coloring = (#[[1, 1, 1]] -> toColor[Last /@ #]) & /@ 
  Partition[SortBy[solution , #[[1, 1]] &], 2]

(** Color each county according to the coloring found: **)

    Black]], {GeoStyling[#2], Tooltip[Polygon[#1], #1[[2]]]} & @@@ 

The above should work as in the example provided in the Help section of the Wolfram Documentation; GeoGraphics; Neat Examples; "Find neighboring European countries" but, I can't figure out what is preventing the above code from working. Please, help me to figure out this problem! Thank you!


marked as duplicate by J. M. will be back soon Nov 13 '17 at 4:12

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.