Week 5 HW - GIS
Katelyn Schreyer
Packages
#install.packages("tmap")
#install.packages("tmaptools")
#install.packages("sf")
#install.packages("leaflet")
#install.packages("leaflet.extras")
#install.packages("rgdal")
#install.packages("htmlwidgets")
library(htmlwidgets)## Warning: package 'htmlwidgets' was built under R version 3.6.3library(tidyverse)## -- Attaching packages ------------------------------------------ tidyverse 1.2.1 --## v ggplot2 3.2.1 v purrr 0.3.2
## v tibble 2.1.3 v dplyr 0.8.3
## v tidyr 0.8.3 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.4.0## Warning: package 'ggplot2' was built under R version 3.6.2## Warning: package 'stringr' was built under R version 3.6.3## -- Conflicts --------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(readxl)
library(tmap)## Warning: package 'tmap' was built under R version 3.6.3library(tmaptools)
library(sf)## Warning: package 'sf' was built under R version 3.6.3## Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1library(leaflet)## Warning: package 'leaflet' was built under R version 3.6.3library(leaflet.extras)## Warning: package 'leaflet.extras' was built under R version 3.6.3library(raster)## Warning: package 'raster' was built under R version 3.6.3## Loading required package: sp## Warning: package 'sp' was built under R version 3.6.3##
## Attaching package: 'raster'## The following object is masked from 'package:dplyr':
##
## select## The following object is masked from 'package:tidyr':
##
## extractlibrary(rgdal)## Warning: package 'rgdal' was built under R version 3.6.3## rgdal: version: 1.5-12, (SVN revision 1018)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.0.4, released 2020/01/28
## Path to GDAL shared files: C:/Users/kschreye/Documents/R/R-3.6.1/library/rgdal/gdal
## GDAL binary built with GEOS: TRUE
## Loaded PROJ runtime: Rel. 6.3.1, February 10th, 2020, [PJ_VERSION: 631]
## Path to PROJ shared files: C:/Users/kschreye/Documents/R/R-3.6.1/library/rgdal/proj
## Linking to sp version:1.4-2
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading rgdal.library(tmap)
library(scales)##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factorData Sources
nhdata <- read_excel("GIS/NHD2016.xlsx")
nhdata <- nhdata[,c("County", "Clinton", "Sanders")]
usgeo <- shapefile("GIS/cb_2014_us_county_5m/cb_2014_us_county_5m.shp")## Warning in rgdal::readOGR(dirname(x), fn, stringsAsFactors =
## stringsAsFactors, : Z-dimension discardedqtm(usgeo)
#str(usgeo)nhdata$SandersMarginVotes <- nhdata$Sanders - nhdata$Clinton
nhdata$SandersPct <- (nhdata$Sanders - nhdata$Clinton) / (nhdata$Sanders + nhdata$Clinton) # Will use formatting later to multiply by a hundred
nhdata$ClintonPct <- (nhdata$Clinton - nhdata$Sanders) / (nhdata$Sanders + nhdata$Clinton)
nhdata$SandersMarginPctgPoints <- nhdata$SandersPct - nhdata$ClintonPctnhgeo <- usgeo[usgeo@data$STATEFP=="33",]
qtm(nhgeo)
nhgeo$NAME <- as.character(nhgeo$NAME)
nhgeo <- nhgeo[order(nhgeo$NAME),]
nhdata <- nhdata[order(nhdata$County),]
identical(nhgeo$NAME,nhdata$County)## [1] TRUEnhmap <- merge(nhgeo, nhdata, by.x = "NAME", by.y = "County") #from Daeshikqtm(nhmap, "SandersMarginVotes")## Some legend labels were too wide. These labels have been resized to 0.62, 0.62, 0.62, 0.57, 0.53. Increase legend.width (argument of tm_layout) to make the legend wider and therefore the labels larger.
qtm(nhmap, "SandersMarginPctgPoints")
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")
tmap_save(nhstaticmap, filename="nhdemprimary.jpg") ## Warning in png(tmp, width = width, height = height, res = res): 'width=7,
## height=7' are unlikely values in pixels## 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 C:\Users\kschreye\Desktop\DATA110\nhdemprimary.jpg## Resolution: 1501.336 by 2937.385 pixels## Size: 5.004452 by 9.791282 inches (300 dpi)It looks like there were some changes to the tmap package.
Instead of tm_style_classic() I used tm_style("classic") Instead of save_tmap I used tmap_save
Interactive Map
clintonPalette <- colorNumeric(palette = "Blues", domain=nhmap$ClintonPct)
nhpopup <- paste0("County: ", nhmap$County,
"Sanders ", percent(nhmap$SandersPct), " - Clinton ", percent(nhmap$ClintonPct))
leaflet(nhmap) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup=nhpopup,
color= ~clintonPalette(nhmap$ClintonPct))South Carolina Data
scdata <- read_csv("GIS/SCGOP2016.csv")## Parsed with column specification:
## cols(
## County = col_character(),
## `Jeb Bush` = col_double(),
## `Ben Carson` = col_double(),
## `Ted Cruz` = col_double(),
## `John R Kasich` = col_double(),
## `Marco Rubio` = col_double(),
## `Donald J Trump` = col_double(),
## Total = col_double()
## )scgeo <- usgeo[usgeo@data$STATEFP=="45",]
qtm(scgeo)
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])
for(i in 1:nrow(scdata)){
scdata$winner[i] <- names(which.max(scdata[i,2:7]))
}## Warning: Unknown or uninitialised column: 'winner'.sced <- read_excel("GIS/SCdegree.xlsx")
str(scgeo$NAME)## chr [1:46] "Edgefield" "Lee" "Horry" "Allendale" "Marion" ...str(scdata$County)## chr [1:46] "Abbeville" "Aiken" "Allendale" "Anderson" "Bamberg" ...scgeo <- scgeo[order(scgeo$NAME),]
scdata <- scdata[order(scdata$County),]
identical(scgeo$NAME,scdata$County )## [1] TRUEscmap <- merge(scgeo, scdata, by.x = "NAME", by.y = "County") 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`))
#I used readr instead of rio so my variable names have spaces. `Backticks` around a variable name with spaces works.
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)
scpopup <- paste0("<b>County: ", scmap$County, "<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%")
#scmap <- sf::st_transform(scmap, "+proj=longlat +datum=WGS84") this line didn't work I'm gonna ignore it and hope for the bestleaflet(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"))Map Layers and Controls
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
scGOPmapsaveWidget(widget=scGOPmap, file="scGOPprimary.html")Trying to use the map controls (selecting the radio buttons) in RStudio causes Rstudio to crash instantly, but it works when I knit/publish it.