There's a 'quintipoint' in Florida, which breaks the ability to have a 4 color map.
See here for more info: http://community.wolfram.com/groups/-/m/t/932548.
About a year ago I did this for all US counties:
Here's the code I used. Note how I manually tweaked the quintipoint.
states = DeleteCases[
Entity["Country", "UnitedStates"][
EntityProperty["Country", "AdministrativeDivisions"]],
s_ /; ! FreeQ[s, "Alaska" | "DistrictOfColumbia" | "Hawaii"]];
$triple =
Entity["AdministrativeDivision", {"PalmBeachCounty" |
"GladesCounty" | "OkeechobeeCounty", "Florida", "UnitedStates"}];
counties =
Join @@ (EntityList[
EntityClass["AdministrativeDivision",
"USCounties" <> CanonicalName[#][[1]]]] & /@ states);
nassoc = EntityValue[counties, "BorderingCounties",
"EntityAssociation"];
neighbors = {#,
Intersection[nassoc[#] /. _Missing -> {}, counties]} & /@
counties;
neighbors =
neighbors /. {c : $triple, n_} :> {c, DeleteCases[n, $triple]};
toColor[tf_] := <|{False, False} -> Red, {False, True} ->
Blue, {True, False} -> Green, {True, True} -> Yellow|>[tf]
eqs = And @@ (Flatten[
Function[{c, n},
BooleanConvert[Xor[x[c], x[#]] || Xor[y[c], y[#]], "CNF"] & /@
n] @@@ neighbors]);
MaxMemoryUsed[
solution =
Join[First[
FindInstance[eqs, Union[Cases[eqs, _x | _y, \[Infinity]]],
Booleans]],
Flatten[{x[#] -> True, y[#] -> True} & /@
Flatten[Cases[neighbors, {_, {}}]]]]] // AbsoluteTiming
coloring = (#[[1, 1, 1]] -> Lighter@Lighter@toColor[Last /@ #]) & /@
Partition[SortBy[solution , #[[1, 1]] &], 2]; // Quiet
(* {206.017, 20929584} *)
GeoGraphics[{
{EdgeForm[{AbsoluteThickness[0.1],
GrayLevel[0.3]}], {GeoStyling[#2], Polygon[#1]} & @@@ coloring},
{EdgeForm[{AbsoluteThickness[1.5], Black}], FaceForm[],
Polygon[EntityList[
EntityClass["AdministrativeDivision", "ContinentalUSStates"]]]}
}, GeoProjection -> "Mercator"]