How to insert short version of county names into a Geo Region Value Plot map

Question

I have the following counties in Florida :

counties = 
 Join @@ EntityValue[{Entity[
     "AdministrativeDivision", {"Florida", "UnitedStates"}]}, 
   EntityProperty["AdministrativeDivision", "Subdivisions"]]

I set my working directory as follows :

   setDir := 
 Quiet@Check[SetDirectory@DirectoryName@$InputFileName, 
   SetDirectory@NotebookDirectory[]]

I have the following values :

   values = {21.2, 15.3, 14.9, 19.1, 12.4, 13.1, 21.1, 10.8, 
   14.4, 9.9, 11.7, 16.5, 26.1, 24.4, 15.1, 16.4, 12., 21.3,
    23.1, 16.1, 18.9, 21.6, 24., 23.3, 23.9, 14., 19.8, 
   15.5, 21.2, 10.6, 18., 17.7, 22.7, 12.6, 11.8, 18., 20.8,
    23., 28.3, 10.8, 16.2, 10.9, 16.7, 11.8, 9.1, 10.9, 
   21.8, 15.3, 14., 11.8, 13., 12.2, 16.1, 26.3, 10.2, 9.2, 
   11.2, 8.3, 12.8, 9.1, 20.3, 23.8, 22.2, 15.2, 12.9, 15.9,
    21.1};

I thread my counties and values as follows:

countyvalueassignment = Thread[counties -> values]

I define the following color function:

 getColor[val_] := 
 Which[8.3 <= val <= 11.7, Yellow, 11.7 < val <= 14, Orange, 
  14 < val <= 16.5, LightGreen, 16.5 < val <= 21.3, LightBlue, 
  21.3 < val <= 28.3, Blue]

and color assignment:

colorassignment = getColor[#] & /@ values

I thread the counties and their colors:

countycolorassignment = Thread[counties -> colorassignment]

and build the following map:

 flmap = GeoRegionValuePlot[countycolorassignment, 
  GeoBackground -> None, ImageSize -> 800]

Now I want to add the following shorter version of the county names. For instance; instead of "Alachua County, Florida, United States" I want only "Alachua". I also want to specify the location of the county - name labels on the map as follows :

countynames = EntityValue[counties, "CanonicalName"];

loc = EntityValue[counties, "Position"];

countyshortnames = StringDrop[#, -6] & /@ countynames[[All, 1]];

Here is the second map:

MapOfFlorida = 
 GeoGraphics[{EdgeForm[{Thick, Black}], GeoStyling["OutlineMap"], 
   Polygon /@ counties, 
   Table[GeoMarker[loc[[j]], 
     Style[countyshortnames[[j]], TextAlignment -> Center, Black, 
      FontSize -> 10, Bold], "Scale" -> 1], {j, 1, 
     Length@countyshortnames}]}, GeoBackground -> None, 
  ImageSize -> 1200]

My question is : how can I insert the short version of the county names (as shown in the "MapOfFlorida" map) into the Geo Region Value plot "flmap"? Thank you for your help!

Answer 1

You are not using all of the options available to you for GeoRegionValuePlot. All of what you are doing manually is already implemented in the options. Read the documentation of the function you are using for more features you are missing out on.

GeoRegionValuePlot[
 Thread[counties -> values],
 ColorFunction -> getColor,
 ColorFunctionScaling -> False,
 GeoLabels -> (GeoMarker[#3, 
     Style[StringDelete["County"]@*First@*CanonicalName@#2, 
      TextAlignment -> Center, Black, FontSize -> 9, Bold], 
     "Scale" -> 1] &),
 PlotLegends -> 
  BarLegend[{{Yellow, Orange, LightGreen, LightBlue, Blue}, {8.3, 28.3}}, 
     {8.3, 11.7, 14, 16.5, 21.3, 28.3}],
 GeoBackground -> None,
 ImageSize -> 1200
 ]

Hope this helps.

Answer 2

Since I haven't received any responses (so far) I'm posting the following as a "final answer" even though I hope to get suggestions about how to improve this code from other Mathematica Stack Exchange participants.

counties = Join @@ EntityValue[{Entity["AdministrativeDivision", {"Florida", "UnitedStates"}]}, EntityProperty["AdministrativeDivision", "Subdivisions"]];

values = {21.2, 15.3, 14.9, 19.1, 12.4, 13.1, 21.1, 10.8, 14.4, 9.9, 
   11.7, 16.5, 26.1, 24.4, 15.1, 16.4, 12.0, 21.3, 23.1, 16.1, 18.9, 
   21.6, 24.0, 23.3, 23.9, 14.0, 19.8, 15.5, 21.2, 10.6, 18.0, 17.7, 
   22.7, 12.6, 11.8, 18.0, 20.8, 23.0, 28.3, 10.8, 16.2, 10.9, 16.7, 
   11.8, 9.1, 10.9, 21.8, 15.3, 14.0, 11.8, 13.0, 12.2, 16.1, 26.3, 
   10.2, 9.2, 11.2, 8.3, 12.8, 9.1, 20.3, 23.8, 22.2, 15.2, 12.9, 
   15.9, 21.1};

countyvalueassignment = Thread[counties -> values];

getColor[val_] := Which[8.3 <= val <= 11.7, Yellow, 11.7 < val <= 14, Orange, 14 < val <= 16.5, LightGreen, 16.5 < val <= 21.3, LightBlue, 21.3 < val <= 28.3, Magenta]

colorassignment = getColor[#] & /@ values

countycolorassignment = Thread[counties -> colorassignment];

flmap = GeoRegionValuePlot[countycolorassignment, GeoBackground -> Transparent, ImageSize -> 1500]

countynames = EntityValue[counties, "CanonicalName"];

countyshortnames = StringDrop[#, -6] & /@ countynames[[All, 1]];

loc = EntityValue[counties, "Position"];


MapOfFlorida = GeoGraphics[{EdgeForm[{Thick, Black}], GeoStyling[Transparent], Polygon /@ counties, Table[GeoMarker[loc[[j]], Rotate[Style[countyshortnames[[j]], TextAlignment -> Center, Black, FontSize -> 14, Bold], 90 Degree], "Scale" -> 1], {j, 1, Length@countyshortnames}]}, GeoBackground -> Transparent, ImageSize -> 1500]

Use ImageMultiply to "fuse" the "flmap" and "MapOfFlorida" maps but, unfortunately notice that two of the county names are chopped; i.e.; Gadsden and Hamilton :

MapOfFloridaWithCountyNames = ImageMultiply[flmap, MapOfFlorida]

Build a legend:

Needs["PlotLegends`"]

legendranges = Graphics[Legend[{{Framed[Graphics[{Yellow, Rectangle[{0, 0}]}]], Text[Style["8.3 - 11.7", Bold, 15]]}, {Framed[Graphics[{Orange, Rectangle[{0, 0}]}]], Text[Style["11.8 - 14.0", Bold, 15]]}, {Framed[Graphics[{LightGreen, Rectangle[{0, 0}]}]], Text[Style["14.1 - 16.5", Bold, 15]]}, {Framed[Graphics[{LightBlue, Rectangle[{0, 0}]}]], Text[Style["16.6 - 21.3", Bold, 15]]}, {Framed[Graphics[{Magenta, Rectangle[{0, 0}]}]], Text[Style["21.4 - 28.3", Bold, 15]]}}, LegendLabel -> Text[Style["Legend", Bold, 18]]]]

Define your working directory:

setDir := Quiet@Check[SetDirectory@DirectoryName@$InputFileName, SetDirectory@NotebookDirectory[]]

setDir

Export the above legend to your working directory to do some further editing to it:

Export["legendranges.png", legendranges]

Open "legendranges.png" in Paintbrush and do the necessary modifications using that software. The file with the modifications is called "desiredlegend.png" and it is provided below:

Now, import your file into your Mathematica platform:

desiredlegend = Import["desiredlegend.png"]

Use Show, Epilog and Inset to insert the desired legend into the map with county names:

MapOfFloridaWithCountyNamesAndLegend = Show[MapOfFloridaWithCountyNames, 
  Epilog -> Inset[desiredlegend, Center, {300, 260}, Scaled[0.5]]]

Export the final map to be used in your presentation:

Export["Florida_Map_with_County_Names_&_Legend(Page 20).png", MapOfFloridaWithCountyNamesAndLegend]

FINIS