nhdatafilecsv <- "NHD2016.xlsx"
usshapefile <- "cb_2014_us_county_5m/cb_2014_us_county_5m.shp"
nhfipscode <- "33"
scdatafile <- "SCGOP2016.csv"
scfipscode <- "45"GIS Tutorial
In this tutorial, I will follow the steps to create a map in R
#install.packages("tmap")
#install.packages("tmaptools")
#install.packages("leaflet")
#install.packages("scales")
#install.packages("leaflet.extras")
#install.packages("rio")
#install.packages("htmlwidgets")
#install.packages("sf")
#install.packages("dplyr")
#install.packages("sp")library(tidyverse)── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
✔ ggplot2 3.4.0 ✔ purrr 1.0.1
✔ tibble 3.1.8 ✔ dplyr 1.1.0
✔ tidyr 1.3.0 ✔ stringr 1.5.0
✔ readr 2.1.4 ✔ forcats 1.0.0
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()library(tmap)
library(tmaptools)
library(leaflet)
library(sf)Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUElibrary(leaflet.extras)
library(rio)
library(sp)getwd()[1] "/Users/renatochavez/Documents/Montgomery College/Spring 2023/DATA110"setwd("/Users/renatochavez/Documents/Montgomery College/Spring 2023/DATA110/GIS")
nhdata <- import(nhdatafilecsv)nhdata <- nhdata[,c("County", "Clinton", "Sanders")]nhdata$SandersMarginVotes <- nhdata$Sanders - nhdata$Clinton
nhdata$SandersPct <- (nhdata$Sanders) / (nhdata$Sanders + nhdata$Clinton)
nhdata$ClintonPct <- (nhdata$Clinton) / (nhdata$Sanders + nhdata$Clinton)
nhdata$SandersMarginPctgPoints <- nhdata$SandersPct - nhdata$ClintonPct#install.packages("raster")
#install.packages("rgdal")
library(raster)
Attaching package: 'raster'The following object is masked from 'package:dplyr':
selectlibrary(rgdal)Please note that rgdal will be retired during 2023,
plan transition to sf/stars/terra functions using GDAL and PROJ
at your earliest convenience.
See https://r-spatial.org/r/2022/04/12/evolution.html and https://github.com/r-spatial/evolution
rgdal: version: 1.6-5, (SVN revision 1199)
Geospatial Data Abstraction Library extensions to R successfully loaded
Loaded GDAL runtime: GDAL 3.5.3, released 2022/10/21
Path to GDAL shared files: /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library/rgdal/gdal
GDAL does not use iconv for recoding strings.
GDAL binary built with GEOS: TRUE
Loaded PROJ runtime: Rel. 9.1.0, September 1st, 2022, [PJ_VERSION: 910]
Path to PROJ shared files: /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library/rgdal/proj
PROJ CDN enabled: FALSE
Linking to sp version:1.6-0
To mute warnings of possible GDAL/OSR exportToProj4() degradation,
use options("rgdal_show_exportToProj4_warnings"="none") before loading sp or rgdal.setwd("/Users/renatochavez/Documents/Montgomery College/Spring 2023/DATA110/GIS")
usgeo <- shapefile("cb_2014_us_county_5m/cb_2014_us_county_5m.shp")Warning: [vect] Z coordinates ignoredsetwd("/Users/renatochavez/Documents/Montgomery College/Spring 2023/DATA110/GIS")
qtm(usgeo)
nhgeo <- usgeo[usgeo$STATEFP==nhfipscode,]qtm(nhgeo)
#str(nhgeo)str(nhgeo$NAME) chr [1:10] "Grafton" "Hillsborough" "Coos" "Belknap" "Rockingham" ...str(nhdata$County) chr [1:10] "Belknap" "Carroll" "Cheshire" "Coos" "Grafton" "Hillsborough" ...nhgeo$NAME <- as.character(nhgeo$NAME)
nhgeo$NAME [1] "Grafton" "Hillsborough" "Coos" "Belknap" "Rockingham"
[6] "Cheshire" "Strafford" "Merrimack" "Carroll" "Sullivan" nhgeo <- nhgeo[order(nhgeo$NAME),]
nhdata <- nhdata[order(nhdata$County),]
if(identical(nhgeo$NAME,nhdata$County)) {
nhmap <- merge(nhgeo, nhdata, by.x = "NAME", by.y = "County")
} else {stop}#str(nhmap)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")
tm_shape(nhmap) +
tm_fill("SandersMarginPctgPoints", title="Sanders Margin, Total Votes", palette = "PRGn") +
tm_borders(alpha=.5) +
tm_text("NAME", size=0.8)
nhstaticmap <- tm_shape(nhmap) +
tm_fill("SandersMarginVotes", title="Sanders Margin, Total Votes", palette = "PRGn") +
tm_borders(alpha=.5) +
tm_text("NAME", size=0.8) +
tm_style("classic")nhstaticmapSome 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.
tmap_save(nhstaticmap, filename="nhdemprimary.jpg")Map saved to /Users/renatochavez/Documents/Montgomery College/Spring 2023/DATA110/nhdemprimary.jpgResolution: 1501.336 by 2937.385 pixelsSize: 5.004452 by 9.791282 inches (300 dpi)clintonPalette <- colorNumeric(palette = "Reds", domain=nhmap$ClintonPct)library(scales)
Attaching package: 'scales'The following object is masked from 'package:purrr':
discardThe following object is masked from 'package:readr':
col_factornhpopup <- paste0("County: ", nhmap$NAME,
"<br /><br /> Sanders ", percent(nhmap$SandersPct), " Clinton ", percent(nhmap$ClintonPct))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))setwd("/Users/renatochavez/Documents/Montgomery College/Spring 2023/DATA110/GIS")
scdata <- rio::import(scdatafile)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]))
}setwd("/Users/renatochavez/Documents/Montgomery College/Spring 2023/DATA110/GIS")
sced <- rio::import("SCdegree.xlsx")#str(scgeo$NAME)
#str(scdata$County)
scgeo$NAME <- as.character(scgeo$NAME)
scgeo <- scgeo[order(scgeo$NAME),]
scdata <- scdata[order(scdata$County),]
if(identical(scgeo$NAME,scdata$County)){
scmap <- merge(scgeo, scdata, by.x = "NAME", by.y = "County")
} else {stop}
#str(scgeo$NAME)
#str(scdata$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`))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$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%")scmap <- sp::spTransform(scmap, "+proj=longlat +datum=WGS84")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"))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),
group = "College degs" ) %>%
addLayersControl(
baseGroups=c("Winners", "Trump", "Rubio", "Cruz", "College degs"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE))
scGOPmap