Justin Park - Interactive Maps
Justin Park
7/4/2021
Creating Interactive Maps
Now that we’ve created our static maps, perhaps we can make this more interesting by making different maps that are interactive for the viewer.
But in order to do so, let’s use a new dataset first - the 2016 Presidiential Prelimaries - and install the necessary packages.
# install.packages("tmap")
# install.pacakges("sf")
# install.packages("tmaptools")
# install.packages(“shiny”)
# install.packages(“urltools”)
# install.packages(“leaflet”)
# install.packages(“scales”)
# install.packages(“leaflet.extras”)
# install.packages(“rio”)
# install.packages(“dplyr”)
# install.packages("raster")
# install.packages("rgdal")library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✓ ggplot2 3.3.5.9000 ✓ purrr 0.3.4
## ✓ tibble 3.1.2 ✓ dplyr 1.0.7
## ✓ tidyr 1.1.3 ✓ stringr 1.4.0
## ✓ readr 1.4.0 ✓ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(tmap)
library(tmaptools)
library(leaflet)
library(sf)## Linking to GEOS 3.8.1, GDAL 3.2.1, PROJ 7.2.1library(leaflet.extras)
library(rio)
library(sp)
library(raster)##
## Attaching package: 'raster'## The following object is masked from 'package:dplyr':
##
## select## The following object is masked from 'package:tidyr':
##
## extractlibrary(rgdal)## rgdal: version: 1.5-23, (SVN revision 1121)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.2.1, released 2020/12/29
## Path to GDAL shared files: /Library/Frameworks/R.framework/Versions/4.1/Resources/library/rgdal/gdal
## GDAL binary built with GEOS: TRUE
## Loaded PROJ runtime: Rel. 7.2.1, January 1st, 2021, [PJ_VERSION: 721]
## Path to PROJ shared files: /Library/Frameworks/R.framework/Versions/4.1/Resources/library/rgdal/proj
## PROJ CDN enabled: FALSE
## Linking to sp version:1.4-5
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading rgdal.
## Overwritten PROJ_LIB was /Library/Frameworks/R.framework/Versions/4.1/Resources/library/rgdal/projlibrary(scales)##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factorlibrary(dplyr)Starting Off
To make it easier, let’s give the individual file names easier names to recall.
nhdatafile <- "NHD2016.xlsx"
nhdatafilecsv <- "NHD2016.csv"
usshapefile <- "cb_2014_us_county_5m/cb_2014_us_county_5m.shp"
nhfipscode <- "33"
scdatafile <- "SCGOP2016.csv"
scfipscode <- "45"Now let’s read in the necessary election result files.
setwd("/Users/justinpark/Desktop/GIS")
nhdata <- import(nhdatafile)
nhdata <- import(nhdatafilecsv)Let’s only call in the columns with the major candidates (Clinton and Sanders) as well as the counties.
nhdata <- nhdata[,c("County", "Clinton", "Sanders")]Deciding the Data to Map
nhdata$SandersMarginVotes <- nhdata$Sanders - nhdata$Clinton
nhdata$SandersPct <- (nhdata$Sanders) / (nhdata$Sanders + nhdata$Clinton)
# Will use formatting later to multiply by a hundred
nhdata$ClintonPct <- (nhdata$Clinton) / (nhdata$Sanders + nhdata$Clinton)
nhdata$SandersMarginPctgPoints <- nhdata$SandersPct - nhdata$ClintonPctNow we need the shapefile for the US country and county map itself.
usgeo <- shapefile("/Users/justinpark/Desktop/GIS/cb_2014_us_county_5m/cb_2014_us_county_5m.shp")## Warning in rgdal::readOGR(dirname(x), fn, stringsAsFactors = stringsAsFactors, :
## Z-dimension discardedQuickly check the map of the US to make sure it works.
qtm(usgeo)
# view(usgeo)Subset just the NH data from the US shapefile.
nhgeo <- usgeo[usgeo$STATEFP == nhfipscode,]Let’s do a tmap test plot of the New Hampshire data to make sure it works.
qtm(nhgeo)
# str(nhgeo)
# str(nhdata$County)
nhgeo$NAME <- as.character(nhgeo$NAME)We ran into a problem here: the county names were in different formats in both files so we have to change them now.
nhgeo <- nhgeo[order(nhgeo$NAME),]
nhdata <- nhdata[order(nhdata$County),]
identical(nhgeo$NAME,nhdata$County)## [1] TRUEThey are now identical so we can move forward. Now let’s order each data by the county name.
nhmap <- merge(nhgeo, nhdata, by.x = "NAME", by.y = "County")
# str(nhmap)Merging the Results Data with the Geo Data
qtm(nhmap, "SandersMarginVotes")## Some legend labels were too wide. These labels have been resized to 0.63, 0.63, 0.63, 0.58, 0.54. Increase legend.width (argument of tm_layout) to make the legend wider and therefore the labels larger.
qtm(nhmap, "SandersMarginPctgPoints")
The “tm_shape” function will give us more control over the appearance of the map.
tm_shape(nhmap) +
tm_fill("SandersMarginVotes", title = "Sanders Margin, Total Votes", palette = "PRGn") +
tm_borders(alpha = .5) +
tm_text("NAME", size = 0.8)## Warning in sp::proj4string(obj): CRS object has comment, which is lost in output## Some legend labels were too wide. These labels have been resized to 0.63, 0.63, 0.63, 0.58, 0.54. Increase legend.width (argument of tm_layout) to make the legend wider and therefore the labels larger.
Same code as above, but store the static map in a variable, and change the theme to “classic” style:
nhstaticmap <- tm_shape(nhmap) +
tm_fill("SandersMarginVotes", title = "Sanders Margin, Total Votes", palette = "viridis") + #I like viridis
tm_borders(alpha = .5) +
tm_text("NAME", size = 0.8) +
tm_style("classic")Let’s view the map with the new style.
nhstaticmap## Warning in sp::proj4string(obj): CRS object has comment, which is lost in output## Some legend labels were too wide. These labels have been resized to 0.63, 0.63, 0.63, 0.58, 0.54. Increase legend.width (argument of tm_layout) to make the legend wider and therefore the labels larger.
Let’s save the map as a .jpg file.
tmap_save(nhstaticmap, filename = "nhdemprimary.jpg") ## Warning in sp::proj4string(obj): CRS object has comment, which is lost in output
## Warning in sp::proj4string(obj): CRS object has comment, which is lost in output## Map saved to /Users/justinpark/Desktop/GIS/nhdemprimary.jpg## Resolution: 1501.336 by 2937.385 pixels## Size: 5.004452 by 9.791282 inches (300 dpi)Creating Palettes
Let’s create a color palette for Clinton
clintonPalette <- colorNumeric(palette = "Blues", domain = nhmap$ClintonPct)As well as a popup window
nhpopup <- paste0("County: ", nhmap$NAME,
"Sanders ", percent(nhmap$SandersPct), " - Clinton ", percent(nhmap$ClintonPct))Generating the Interactive Map
nhmap_projected <- sp::spTransform(nhmap, "+proj=longlat +datum=WGS84")
leaflet(nhmap_projected) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup=nhpopup,
color= ~clintonPalette(nhmap$ClintonPct)
) Unlike before, we can now click on specific regions to see the amount of votes each candidate got (in percents). We can even choose to zoom in or out for a better view of the map. Now let’s move onto a different dataset
South Carolina Data
setwd("/Users/justinpark/Desktop/GIS")
scdata <- rio::import(scdatafile)Let’s check out the map for South Carolina
scgeo <- usgeo[usgeo@data$STATEFP == "45",]
qtm(scgeo)
We need to add a column with the percent votes of each candidate. The candidates are in columns 2-7 on the original file.
candidates <- colnames(scdata[2:7])
for(i in 2:7){
j = i + 7
temp <- scdata[[i]] / scdata$Total
scdata[[j]] <- temp
colnames(scdata)[j] <- paste0(colnames(scdata)[i], "Pct")
}
winner <- colnames(scdata[2:7])Now let’s get the winner in each precinct
for(i in 1:nrow(scdata)){
scdata$winner[i] <- names(which.max(scdata[i,2:7]))
}Import Spreadsheet of the Population Precentage of Adults with at Least a 4 yr College Degree
setwd("/Users/justinpark/Desktop/GIS")
sced <- rio::import("SCdegree.xlsx")Check to see if the counties are in the same format like before.
str(scgeo$NAME)## chr [1:46] "Edgefield" "Lee" "Horry" "Allendale" "Marion" "Dorchester" ...str(scdata$County)## chr [1:46] "Abbeville" "Aiken" "Allendale" "Anderson" "Bamberg" "Barnwell" ...str(scdata$County)## chr [1:46] "Abbeville" "Aiken" "Allendale" "Anderson" "Bamberg" "Barnwell" ...Add the election results and rename county column
scmap <- merge(scgeo, scdata, by.x = "NAME", by.y = "County") Instead of just coloring the winner, let’s color by strength of win with multiple layers.
minpct <- min(c(scdata$`Donald J TrumpPct`, scdata$`Marco RubioPct`, scdata$`Ted CruzPct`))
maxpct <- max(c(scdata$`Donald J TrumpPct`, scdata$`Marco RubioPct`, scdata$`Ted CruzPct`))Now we need leaflet palettes for each layer of the map. We’ll use shades of Red as these candidates are from the GOP.
trumpPalette <- colorNumeric(palette = "Purples", domain = c(minpct, maxpct))
rubioPalette <- colorNumeric(palette = "Reds", domain = c(minpct, maxpct))
cruzPalette <- colorNumeric(palette = "Oranges", domain = c(minpct, maxpct))
winnerPalette <- colorFactor(palette = c("#984ea3", "#e41a1c"), domain = scmap$winner)
edPalette <- colorNumeric(palette = "Blues", domain = scmap$PctCollegeDegree)Create the popup window.
scpopup <- paste0("<b>County: ", scmap$NAME, "<br />Winner: ", scmap$winner, "</b><br /><br />Trump: ",
percent(scmap$`Donald J TrumpPct`), "<br />Rubio: ",
percent(scmap$`Marco RubioPct`), "<br />Cruz: ",
percent(scmap$`Ted CruzPct`), "<br /><br />Pct w college ed: ",
sced$PctCollegeDegree, "% vs state-wide avg of 25%")Add the projection we know from the NH map we’ll need for this data on a Leaflet map
scmap <- sp::spTransform(scmap, "+proj=longlat +datum=WGS84")Create the basic map showing the winner of each county
leaflet(scmap) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke = TRUE,
weight = 1,
smoothFactor = 0.2,
fillOpacity = .75,
popup = scpopup,
color = ~winnerPalette(scmap$winner),
group = "Winners" ) %>%
addLegend(position = "bottomleft", colors = c("#984ea3", "#e41a1c"), labels = c("Trump", "Rubio"))Not too much data displayed on this map. Let’s make it more advanced.
Final Map
Let’s add the top 3 candidates in their own layer for separate displays. Then add the education layer to compare the winners and college degree percentage holders. There may be some interesting finds.
scGOPmap <- leaflet(scmap) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke = TRUE,
weight = 1,
smoothFactor = 0.2,
fillOpacity = .75,
popup = scpopup,
color = ~winnerPalette(scmap$winner),
group = "Winners" ) %>%
addLegend(position = "bottomleft", colors = c("#984ea3", "#e41a1c"), labels = c("Trump", "Rubio")) %>%
addPolygons(stroke = TRUE,
weight = 1,
smoothFactor = 0.2,
fillOpacity = .75,
popup = scpopup,
color = ~trumpPalette(scmap$`Donald J TrumpPct`),
group = "Trump") %>%
addPolygons(stroke = TRUE,
weight = 1,
smoothFactor = 0.2,
fillOpacity = .75,
popup = scpopup,
color = ~rubioPalette(scmap$`Marco RubioPct`),
group = "Rubio") %>%
addPolygons(stroke = TRUE,
weight = 1,
smoothFactor = 0.2,
fillOpacity = .75,
popup = scpopup,
color = ~cruzPalette(scmap$`Ted CruzPct`),
group = "Cruz") %>%
addPolygons(stroke = TRUE,
weight = 1,
smoothFactor = 0.2,
fillOpacity = .75,
popup = scpopup,
color = ~edPalette(sced$PctCollegeDegree), #this data is in the sced table, not scmaps
group = "College degs") %>%
addLayersControl(
baseGroups = c("Winners", "Trump", "Rubio", "Cruz", "College degs"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE))
# Now display the map
scGOPmap