Choropleth Maps using Plotly in R

Question

I would like to make an interactive choropleth map so that when I hover over a Region it will display a Count and the name of the Region I am hovering over. The data set I am working with can be quickly downloaded here. ftp://ftp.agrc.utah.gov/UtahSGID_Vector/UTM12_NAD83/HEALTH/UnpackagedData/HealthDistricts2015/_Statewide/HealthDistricts2015_shp.zip

Here is what I have to far.

library(ggplot2)
library(rgdal)
utah <- readOGR(dsn= "PATH/HealthDistricts2015.shp", layer = "HealthDistricts2015")
utah@data$id = rownames(utah@data)
utah.points = fortify(utah, region="id")
utah.df = inner_join(utah.points, utah@data, by="id")

colnames(utah.df)[8] = "Region"
UDist <- sort(unique(as.character(utah.df$Region)))
RegionS = data.frame(Region = UDist, Count = sample(1:length(UDist)))

PlotData <- left_join(utah.df, RegionS, b = "Region")


ggplot(PlotData, aes(long,lat,group=group,fill=Count)) +
    geom_polygon() +
    geom_path(color="black") +
    coord_equal() + 
    theme_bw() +
    theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        panel.grid.minor = element_blank(),
        panel.grid.major = element_line(colour = "white")
        ) +
    xlab("") +
    ylab("")

This code gives me a nice choropleth map, but I would like to add the hovering capabilities. I tried using ggplotly() but it did not give me a nice plot. I have tried to figure out how to plot this with plot_ly(), but wasn't able to get anywhere. Is there a way I could create a plot like this, but when I hover show "Count" and "Region"?

Answer 1

You could use mapbox together with Plotly.

First convert the coordinates of the ArcGIS shape file

lat_lon <- spTransform(utah, CRS("+proj=longlat +datum=WGS84"))

Next convert the data to a GeoJSON object

utah_geojson <- geojson_json(lat_lon)
geoj <- fromJSON(utah_geojson)

Then add each district as a separate layer

for (i in 1:length(geoj$features)) {
  all_layers[[i]] = list(sourcetype = 'geojson', 
                         source = geoj$features[[i]], 
                         type = 'fill',
                         )
}
p %>% layout(mapbox = list(layers = all_layers))

For the hoverinfo we just add a dot for the centroid of each district

p <- add_trace(p, 
               type='scattergeo',
               x = lat_lon@polygons[[i]]@labpt[[1]],
               y = lat_lon@polygons[[i]]@labpt[[2]],
               showlegend = FALSE,
               text = lat_lon@data[[1]][[i]],
               hoverinfo = 'text',
               mode = 'markers'
               )

---

Complete code

library(rgdal)
library(geojsonio)
library(rjson)
library(plotly)

Sys.setenv('MAPBOX_TOKEN' = 'secret_token')

utah <- readOGR(dsn= "HealthDistricts2015.shp", layer = "HealthDistricts2015")
lat_lon <- spTransform(utah, CRS("+proj=longlat +datum=WGS84"))
utah_geojson <- geojson_json(lat_lon)
geoj <- fromJSON(utah_geojson)
all_layers <- list()

my_colors <- terrain.colors(length(geoj$features))

p <- plot_mapbox()
for (i in 1:length(geoj$features)) {
  all_layers[[i]] = list(sourcetype = 'geojson', 
                         source = geoj$features[[i]], 
                         type = 'fill',
                         color = substr(my_colors[[i]], 1, 7),
                         opacity = 0.5
                         )
  p <- add_trace(p, 
                 type='scattergeo',
                 x = lat_lon@polygons[[i]]@labpt[[1]],
                 y = lat_lon@polygons[[i]]@labpt[[2]],
                 showlegend = FALSE,
                 text = lat_lon@data[[1]][[i]],
                 hoverinfo = 'text',
                 mode = 'markers'
                 )


}

p %>% layout(title = 'Utah',
             mapbox = list(center= list(lat=38.4, lon=-111),
                           zoom = 5.5,
                           layers = all_layers)

             )