# Applying the Four-color Theorem to the map of Florida [duplicate]

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 =
EntityList[


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 =


Since evaluating;

 borderingcounties[[1]]


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:

 borderingcounties


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 :

    GeoGraphics[{
GeoStyling["OutlineMap",
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 =
Table[{counties[[i]],
Intersection[borderingcounties[[i]], counties]}, {i, 1,
Length[counties]}];


(** 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 =
Join[First[
FindInstance[eqs, Union[Cases[eqs, _x | _y, \[Infinity]]],
Booleans]],
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: **)

    GeoGraphics[{EdgeForm[
Directive[Thin,
Black]], {GeoStyling[#2], Tooltip[Polygon[#1], #1[[2]]]} & @@@
coloring}]


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!