Plots of United States states with non-standard labels

Question

I have data that associates a state with some text (like the name of its biggest insurance company). The states are identified as Wolfram Language entities, e.g. Entity["AdministrativeDivision", {"Arkansas", "UnitedStates"}]. I want to create a plot (probably using GeoGraphics) that displays the states as simple polygons, but instead of labeling the state "Arkansas" or whatever, it labels the state via the associated text. Thus, if "Blue Cross" were the name of the biggest insurer in Arkansas, the Arkansas polygon would be labeled "Blue Cross" at some reasonable position with Arkansas.

1. How to best do this?

Extra credit

2. You know how people frequently make maps of the United States in which Alaska and Hawaii are not their true size and not in their true location but instead in sizes and places that makes the display compact. Any idea how to do this simply in Mathematica?

Answer 1

I don't have Mathematica 10, so I used the KML file http://code.google.com/apis/kml/documentation/us_states.kml

The only real improvement I made is modifying the text font size based on the state's width. This doesn't work 100%, since Mathematica doesn't use a monospaced font, but most of the "names" now fit approximately into their states.

Other things I did that aren't really improvements:

• Omitted Hawaii and Alaska (no insets), since they drastically reduce the space available for the continental United States (no extra credit for me).

• Used an equiangular projection, which works OK for the continental United States.

• Replaced the names of the 50 states with the list of words that sound rude but aren't: http://mentalfloss.com/article/58036/50-words-sound-rude-actually-arent

My code:

(* list of "names" is in this file *) 

<<"/home/barrycarter/BCGIT/STACK/badwords.m"; 

(* I downloaded a local copy of http://code.google.com/apis/kml/documentation/us_states.kml but could've also imported it as http *) 

usa = Import["/home/barrycarter/BCGIT/STACK/us_states.kml", "Data"]; 

(* helper functions *) 
state[n_] := usa[[1,2,2,n]] 
name[n_] := usa[[1,6,2,n]] 
centroid[n_] := Flatten[Apply[List,state[n][[1]]]] 
ewpoints[n_] := Transpose[Partition[Flatten[Apply[List,state[n],1]],2]] 
width[n_] := Max[ewpoints[n][[1]]]-Min[ewpoints[n][[1]]] 

(* omitting Alaska and Hawaii; cheating because I looked up their numbers, instead of omitting them "properly" *) 
states = Table[i, {i,Flatten[{1,Range[3,10],Range[12,50]}]}]; 

(* note the fontsize is tied to the ImageSize in the later Export *) 
g = Table[{ 
 EdgeForm[Thin], 
 Text[Style[f[i], FontSize-> 60*width[i]/StringLength[f[i]]], centroid[i]], 
 Opacity[0.1], 
 state[i] 
}, {i,states}]; 

Show[Graphics[g], AspectRatio -> 1/1.5] 
Export["/tmp/test.gif", %, ImageSize -> {1024*3,768*3}] 

The result (please view full size for maximum effect):

Git: https://github.com/barrycarter/bcapps/blob/master/STACK/bc-state-names.m

Answer 2

GeoMarkers gets the job done. Here's a plot of sales taxes:

states = EntityValue[Entity["Country", "UnitedStates"], "AdministrativeDivisions"];
states = DeleteCases[states, Entity["AdministrativeDivision", {"Hawaii", "UnitedStates"}] | Entity["AdministrativeDivision", {"Alaska", "UnitedStates"}]];
polygons = Polygon /@ states;
markers = GeoMarker[#, QuantityMagnitude[EntityValue[#, EntityProperty["AdministrativeDivision", "StateSalesTaxRate"]]]] & /@ states;
GeoGraphics[{GeoStyling["OutlineMap"], polygons, markers}, ImageSize -> 1000, GeoBackground -> None]

Some labels overlap, and this problem will be even larger when you have text labels. I think that the standard solution is to position some of the labels, for the small north eastern states for example, manually. Note that you can select the label in the map and drag it around.

If you want the labels to be of different size like in barrycarter's answer this can also be accommodated by GeoMarkers, as it takes a "Scale" parameter. The label size can be made to be proportional to state area for example.

Answer 3

This is rather ugly but perhaps will motivate others to exploit new functionalities.

states = EntityValue[Entity["Country", "UnitedStates"], 
   "AdministrativeDivisions"];
base = GeoRegionValuePlot[Thread[res -> RandomColor[51]]];
pg = Cases[g[[1, 1]], Polygon[x__] :> Polygon[x], Infinity];
statepg = pg[[3 ;;]];
cn = RegionCentroid[DiscretizeRegion[#]] & /@ statepg;
treesp = Cases[tree, Commented[__, s_] :> s];
cf[u_] := Hue[(u - 1)/50];
plot = MapIndexed[{cf[#2[[1]]], #1[[1]], 
     Text[Framed[Style[#1[[2]], Yellow, Bold, 12], 
       Background -> Black], #1[[3]]]} &, 
   Transpose[{statepg, treesp, cn}]];
gr = Graphics[plot, ImageSize -> 1600]

I apologize for the ugly colorscheme. The primary purpose was illustrative. Note:

• GeoRegionValuePlot was just used to get polygons. My cursory look at properties from EntityValue[Entity["Country", "UnitedStates"], "Properties"]. I am certain there are better ways.

• I had to check the polygons: reason for pg[[3;;]]

• DiscretizeRegion was needed to deal with the complex shape of Oklahoma

• Zoom the plot to see resolution (not svg obviously).

• other projections may more desirable

I know there will be much better ways to do this and look forward to learning from them.