wdi_leaflet.R

# This function and helper functions create a Leaflet interactive map in R from a World Bank indicator. This code was created by Kyle E. Walker, director of the Center for Urban Studies at Texas Christian University and (very) slightly modified by Sharon Machlis. See Walker's kwgeo package at https://github.com/walkerke/kwgeo/ for more info. Any errors are most certainly Sharon's.


if (!require("WDI")) install.packages("WDI")
if (!require("rgdal")) install.packages("rgdal")
if (!require("sp")) install.packages("sp")
if (!require("leaflet")) install.packages("leaflet")
if (!require("httr")) install.packages("httr")
if (!require("maptools")) install.packages("maptools")


library("WDI")
library("rgdal")
library("sp")
library("leaflet")
library("httr")
library("maptools")

wdi_leaflet <- function(indicator, indicator_alias = "Value", year = 2012, classes = 5, colors = "Blues") {
  
  url <- "http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/50m/cultural/ne_50m_admin_0_countries.zip"
  
  tmp <- tempdir()
  
  file <- basename(url)
  
  download.file(url, file)
  
  unzip(file, exdir = tmp)
  
  countries <- readOGR(dsn = tmp,
                       layer = "ne_50m_admin_0_countries",
                       encoding = "UTF-8",
                       verbose = FALSE)
  
  
  dat <- WDI(country = "all",
             indicator = indicator,
             start = year,
             end = year)
  
  dat[[indicator]] <- round(dat[[indicator]], 1)
  
  
  
  countries2 <- geo_join(countries, dat,"iso_a2", "iso2c")
  
  pal <- colorQuantile(colors, NULL, n = classes)
  
  labs <- quantile_labels(countries2[[indicator]], classes)
  
  country_popup <- paste0("<strong>Country: </strong>",
                          countries2$name_long,
                          "<br><strong>",
                          indicator_alias,
                          ", ",
                          as.character(year),
                          ": </strong>",
                          countries2[[indicator]])
  
  stamen_tiles <- "http://{s}.tile.stamen.com/toner-lite/{z}/{x}/{y}.png"
  
  stamen_attribution <- 'Map tiles by <a href="http://stamen.com">Stamen Design</a>, under <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a>. Data by <a href="http://openstreetmap.org">OpenStreetMap</a>, under <a href="http://www.openstreetmap.org/copyright">ODbL</a>.'
  
  leaflet(data = countries2) %>%
    addTiles(urlTemplate = stamen_tiles,
             attribution = stamen_attribution) %>%
    setView(0, 0, zoom = 2) %>%
    addPolygons(fillColor = ~pal(countries2[[indicator]]),
                fillOpacity = 0.8,
                color = "#BDBDC3",
                weight = 1,
                popup = country_popup) %>%
    addLegend(colors = c(RColorBrewer::brewer.pal(classes, colors), "#808080"),
              position = "bottomright",
              bins = classes,
              labels = labs,
              title = paste0(indicator_alias, ", ", as.character(year))
    )
  
}


# The following helper functions are all created by Kyle E. Walker

#'  Easily merge a data frame to a spatial data frame
#'
#'  The pages of StackOverflow are littered with questions about how to merge a regular data frame to a
#'  spatial data frame in R.  The \code{merge} function from the sp package operates under a strict set of
#'  assumptions, which if violated will break your data.  This function wraps a couple StackOverflow answers
#'  I've seen that work in a friendlier syntax.
#' @param spatial_data A spatial data frame to which you want to merge data.
#' @param data_frame A regular data frame that you want to merge to your spatial data.
#' @param by_sp The column name you'll use for the merge from your spatial data frame.
#' @param by_df The column name you'll use for the merge from your regular data frame.
#' @export

geo_join <- function(spatial_data, data_frame, by_sp, by_df) {
  
  spatial_data@data <- data.frame(spatial_data@data,
                                  data_frame[match(spatial_data@data[[by_sp]],
                                                   data_frame[[by_df]]), ])
  
  spatial_data
  
  
}

#'  Quick transform of spatial objects to WGS84
#'
#'  The function will use \code{spTransform} from the \code{rgdal} package to automatically transform your
#'  spatial data to the WGS84 geographic coordinate system.  As this is the coordinate system required for mapping
#'  with the \code{leaflet} package, it can come in handy when mapping spatial objects in R.
#' @param sp_object an R object of class \code{Spatial*} that you'd like to transform to WGS84.
#' @import rgdal
#' @export

transform_xy <- function(sp_object) {
  sp_xy <- spTransform(sp_object, CRS("+proj=longlat +datum=WGS84"))
  sp_xy
}



#'  Create nice-looking quantile labels for Leaflet mapping.
#'
#'  At present, the amazing \code{leaflet} package uses percentiles in its quantile legends; however, sometimes you
#'  want to show the actual values.  This function allows you to do just that.
#' @param vec The column of data that you are visualizing on your choropleth map
#' @param n The number of classes you've chosen
#' @export

quantile_labels <- function(vec, n) {
  qs <- round(quantile(vec, seq(0, 1, 1/n), na.rm = TRUE), 1)
  len <- length(qs) - 1
  qlabs <- c()
  for (i in 1:len) {
    j <- i + 1
    v <- paste0(as.character(qs[i]), "-", as.character(qs[j]))
    qlabs <- c(qlabs, v)
  }
  final_labs <- c(qlabs, "Data unavailable")
  final_labs
}

# Sample use:
# wdi_leaflet(indicator = "NY.GNP.PCAP.CD", indicator_alias="Average annual income", year = 2015 , classes = 5, colors = "RdPu")