# Set various values needed, including names of files and FIPS codes for New Hampshire and South Carolina
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"
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.6 ✓ dplyr 1.0.8
## ✓ tidyr 1.2.0 ✓ stringr 1.4.0
## ✓ readr 2.1.2 ✓ 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.9.1, GDAL 3.2.3, PROJ 7.2.1; sf_use_s2() is TRUE
library(leaflet.extras)
library(dplyr)
library(rio)
library(sp)
setwd("/Users/michellenguyen/Downloads/GIS")
nhdata <- import(nhdatafilecsv)
nhdata <- nhdata[,c("County", "Clinton", "Sanders")]
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$ClintonPct
setwd("/Users/michellenguyen/Downloads/GIS")
usgeo <- st_read("cb_2014_us_county_5m/cb_2014_us_county_5m.shp")
## Reading layer `cb_2014_us_county_5m' from data source
## `/Users/michellenguyen/Downloads/GIS/cb_2014_us_county_5m/cb_2014_us_county_5m.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 3233 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension: XYZ
## Bounding box: xmin: -179.1473 ymin: -14.55255 xmax: 179.7785 ymax: 71.35256
## z_range: zmin: 0 zmax: 0
## Geodetic CRS: NAD83
qtm(usgeo)
nhgeo <- usgeo[usgeo$STATEFP==nhfipscode,]
qtm(nhgeo)
str(nhgeo)
## Classes 'sf' and 'data.frame': 10 obs. of 10 variables:
## $ STATEFP : chr "33" "33" "33" "33" ...
## $ COUNTYFP: chr "009" "011" "007" "001" ...
## $ COUNTYNS: chr "00873178" "00873179" "00873177" "00873174" ...
## $ AFFGEOID: chr "0500000US33009" "0500000US33011" "0500000US33007" "0500000US33001" ...
## $ GEOID : chr "33009" "33011" "33007" "33001" ...
## $ NAME : chr "Grafton" "Hillsborough" "Coos" "Belknap" ...
## $ LSAD : chr "06" "06" "06" "06" ...
## $ ALAND : num 4.43e+09 2.27e+09 4.65e+09 1.04e+09 1.80e+09 ...
## $ AWATER : num 1.05e+08 4.16e+07 9.08e+07 1.77e+08 2.60e+08 ...
## $ geometry:sfc_MULTIPOLYGON of length 10; first list element: List of 1
## ..$ :List of 1
## .. ..$ : num [1:327, 1:3] -72.3 -72.3 -72.3 -72.3 -72.3 ...
## ..- attr(*, "class")= chr [1:3] "XYZ" "MULTIPOLYGON" "sfg"
## - attr(*, "sf_column")= chr "geometry"
## - attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA NA NA NA NA NA NA NA NA
## ..- attr(*, "names")= chr [1:9] "STATEFP" "COUNTYFP" "COUNTYNS" "AFFGEOID" ...
str(nhdata$County)
## chr [1:10] "Belknap" "Carroll" "Cheshire" "Coos" "Grafton" "Hillsborough" ...
# They're not. Change the county names to plain characters in nhgeo:
nhgeo$NAME <- as.character(nhgeo$NAME)
nhgeo <- nhgeo[order(nhgeo$NAME),]
nhdata <- nhdata[order(nhdata$County),]
# Are the two county columns identical now? They should be:
identical(nhgeo$NAME,nhdata$County)
## [1] TRUE
library(sf)
nhmap <- merge(nhgeo, nhdata, by.x = "NAME", by.y = "County")
# See the new data structure with
str(nhmap)
## Classes 'sf' and 'data.frame': 10 obs. of 16 variables:
## $ NAME : chr "Belknap" "Carroll" "Cheshire" "Coos" ...
## $ STATEFP : chr "33" "33" "33" "33" ...
## $ COUNTYFP : chr "001" "003" "005" "007" ...
## $ COUNTYNS : chr "00873174" "00873175" "00873176" "00873177" ...
## $ AFFGEOID : chr "0500000US33001" "0500000US33003" "0500000US33005" "0500000US33007" ...
## $ GEOID : chr "33001" "33003" "33005" "33007" ...
## $ LSAD : chr "06" "06" "06" "06" ...
## $ ALAND : num 1.04e+09 2.41e+09 1.83e+09 4.65e+09 4.43e+09 ...
## $ AWATER : num 1.77e+08 1.59e+08 5.80e+07 9.08e+07 1.05e+08 ...
## $ Clinton : int 3495 3230 5132 2013 6918 28147 12250 22829 8813 2497
## $ Sanders : int 6005 5638 12441 3639 14245 39245 18107 31065 15881 5915
## $ SandersMarginVotes : int 2510 2408 7309 1626 7327 11098 5857 8236 7068 3418
## $ SandersPct : num 0.632 0.636 0.708 0.644 0.673 ...
## $ ClintonPct : num 0.368 0.364 0.292 0.356 0.327 ...
## $ SandersMarginPctgPoints: num 0.264 0.272 0.416 0.288 0.346 ...
## $ geometry :sfc_MULTIPOLYGON of length 10; first list element: List of 1
## ..$ :List of 1
## .. ..$ : num [1:33, 1:3] -71.7 -71.7 -71.7 -71.7 -71.7 ...
## ..- attr(*, "class")= chr [1:3] "XYZ" "MULTIPOLYGON" "sfg"
## - attr(*, "sf_column")= chr "geometry"
## - attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA NA NA NA NA NA NA NA NA NA ...
## ..- attr(*, "names")= chr [1:15] "NAME" "STATEFP" "COUNTYFP" "COUNTYNS" ...
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("SandersMarginVotes", title="Sanders Margin, Total Votes", palette = "PRGn") +
tm_borders(alpha=.5) +
tm_text("NAME", size=0.8)
## 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.
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")
nhstaticmap
## 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.
tmap_save(nhstaticmap, filename="nhdemprimary.jpg")
## Map saved to /Users/michellenguyen/Downloads/GIS/nhdemprimary.jpg
## Resolution: 1501.336 by 2937.385 pixels
## Size: 5.004452 by 9.791282 inches (300 dpi)
clintonPalette <- colorNumeric(palette = "Blues", domain=nhmap$ClintonPct)
library(scales)
##
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
##
## discard
## The following object is masked from 'package:readr':
##
## col_factor
#library(raster)
nhpopup <- paste0("County: ", nhmap$NAME,
"Sanders ", percent(nhmap$SandersPct), " - Clinton ", percent(nhmap$ClintonPct))
# I get the error Error in sf_transform(nhmap, "+proj=longlat +datum=WGS84") :
# could not find function "sf_transform" for chunk below
# re-project
#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/michellenguyen/Downloads/GIS")
scdata <- rio::import(scdatafile)
scgeo <- usgeo[usgeo$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/michellenguyen/Downloads/GIS")
sced <- rio::import("SCdegree.xlsx")
str(scgeo$NAME)
## chr [1:46] "Edgefield" "Lee" "Horry" "Allendale" "Marion" "Dorchester" ...
str(scdata$County)
## chr [1:46] "Abbeville" "Aiken" "Allendale" "Anderson" "Bamberg" "Barnwell" ...
scgeo$NAME <- as.character(scgeo$NAME)
scgeo <- scgeo[order(scgeo$NAME),]
scdata <- scdata[order(scdata$County),]
identical(scgeo$NAME,scdata$County )
## [1] TRUE
scmap <- merge(scgeo, scdata, by.x = "NAME", by.y = "County")
# Use same intensity for all - get minimum and maximum for the top 3 combined
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%")
# I get the error Error in (function (classes, fdef, mtable) : unable to find an inherited method for function ‘spTransform’ for signature ‘"sf", "character"’ for chunk below
#scmap <- sp::spTransform(scmap, "+proj=longlat +datum=WGS84")
# I get the error Error in if (length(nms) != n || any(nms == "")) stop("'options' must be a fully named list, or have no names (NULL)") : missing value where TRUE/FALSE needed for chunk below
#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", "R
#ubio"))
# I get the error Error: unexpected symbol in:
#" color= ~edPalette(sced$PctCollegeDegree), #this data #is in the sced table,
#not scmaps" for chunk below
#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", "R
#ubio")) %>%
#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
#htmlwidgets::saveWidget(scGOPmap2, file="scGOPwidget2.html")
# save as an HTML file with dependencies in another directory:
#htmlwidgets::saveWidget(widget=scGOPmap2, file="scGOPprimary_withdependencies.html", selfcontained=FALSE, libdir = "js")