Week 9
Rohin Garg
10/30/2019
setwd("C:/Users/munis/Documents/Comm in Data Science/Week 9")
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) # my additions## -- 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 1.0.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.4.0## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(ggplot2)
library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layout#
library(scales) # referenced below##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factor# following per original script
library("tmap")
library("tmaptools")
library("leaflet")
library("sf")## Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3library("leaflet.extras")
library("dplyr")nhdata <- rio::import(nhdatafile)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$ClintonPctusshapefile <- "cb_2014_us_county_5m/cb_2014_us_county_5m.shp"
usgeo <- read_shape(file=usshapefile, as.sf = TRUE)## Warning: This function is deprecated and has been migrated to github.com/
## mtennekes/oldtmaptools## Warning in readOGR(dir, base, verbose = FALSE, ...): Z-dimension discardedqtm(usgeo)
str(usgeo)## Classes 'sf' and 'data.frame': 3233 obs. of 10 variables:
## $ STATEFP : Factor w/ 56 levels "01","02","04",..: 1 11 16 37 39 37 28 26 29 10 ...
## $ COUNTYFP: Factor w/ 328 levels "001","003","005",..: 42 76 74 78 78 38 22 137 291 35 ...
## $ COUNTYNS: Factor w/ 3233 levels "00023901","00025441",..: 120 430 738 1911 2024 1880 1399 1373 1490 298 ...
## $ AFFGEOID: Factor w/ 3233 levels "0500000US01001",..: 30 442 844 2189 2302 2158 1669 1589 1764 344 ...
## $ GEOID : Factor w/ 3233 levels "01001","01003",..: 30 442 844 2189 2302 2158 1669 1589 1764 344 ...
## $ NAME : Factor w/ 1921 levels "Abbeville","Acadia",..: 620 592 945 1291 1665 692 320 1683 284 747 ...
## $ LSAD : Factor w/ 11 levels "00","03","04",..: 5 5 5 5 5 5 5 5 1 5 ...
## $ ALAND : Factor w/ 3233 levels "1000508842","1001064387",..: 1199 5 2047 452 1721 2091 1880 1194 2397 1215 ...
## $ AWATER : Factor w/ 3233 levels "0","10017640",..: 1626 414 1940 1718 1118 2724 2916 2228 1613 497 ...
## $ geometry:sfc_MULTIPOLYGON of length 3233; first list element: List of 1
## ..$ :List of 1
## .. ..$ : num [1:9, 1:2] -88.2 -88.2 -88.2 -88.1 -87.5 ...
## ..- attr(*, "class")= chr "XY" "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 "STATEFP" "COUNTYFP" "COUNTYNS" "AFFGEOID" ...nhgeo <- usgeo[usgeo$STATEFP==nhfipscode,]nhgeo <- dplyr::filter(usgeo, STATEFP == nhfipscode)qtm(nhgeo)
str(nhgeo)## Classes 'sf' and 'data.frame': 10 obs. of 10 variables:
## $ STATEFP : Factor w/ 56 levels "01","02","04",..: 30 30 30 30 30 30 30 30 30 30
## $ COUNTYFP: Factor w/ 328 levels "001","003","005",..: 6 8 5 1 12 3 14 10 2 15
## $ COUNTYNS: Factor w/ 3233 levels "00023901","00025441",..: 1500 1501 1499 1496 1503 1498 1504 1502 1497 1505
## $ AFFGEOID: Factor w/ 3233 levels "0500000US01001",..: 1769 1770 1768 1765 1772 1767 1773 1771 1766 1774
## $ GEOID : Factor w/ 3233 levels "01001","01003",..: 1769 1770 1768 1765 1772 1767 1773 1771 1766 1774
## $ NAME : Factor w/ 1921 levels "Abbeville","Acadia",..: 684 791 416 138 1470 334 1653 1131 282 1657
## $ LSAD : Factor w/ 11 levels "00","03","04",..: 5 5 5 5 5 5 5 5 5 5
## $ ALAND : Factor w/ 3233 levels "1000508842","1001064387",..: 2494 1831 2526 67 1382 1424 3172 1997 1991 730
## $ AWATER : Factor w/ 3233 levels "0","10017640",..: 55 1942 3097 778 1327 2460 1852 2454 638 1817
## $ geometry:sfc_MULTIPOLYGON of length 10; first list element: List of 1
## ..$ :List of 1
## .. ..$ : num [1:327, 1:2] -72.3 -72.3 -72.3 -72.3 -72.3 ...
## ..- attr(*, "class")= chr "XY" "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 "STATEFP" "COUNTYFP" "COUNTYNS" "AFFGEOID" ...str(nhgeo$NAME)## Factor w/ 1921 levels "Abbeville","Acadia",..: 684 791 416 138 1470 334 1653 1131 282 1657str(nhdata$County)## chr [1:10] "Belknap" "Carroll" "Cheshire" "Coos" "Grafton" ...nhgeo$NAME <- as.character(nhgeo$NAME)nhgeo <- nhgeo[order(nhgeo$NAME),]
nhdata <- nhdata[order(nhdata$County),]identical(nhgeo$NAME,nhdata$County )## [1] TRUEnhmap <- append_data(nhgeo, nhdata, key.shp = "NAME", key.data="County")## Warning: This function is deprecated and has been migrated to github.com/
## mtennekes/oldtmaptools## Keys match perfectly.str(nhmap)## Classes 'sf' and 'data.frame': 10 obs. of 16 variables:
## $ STATEFP : Factor w/ 56 levels "01","02","04",..: 30 30 30 30 30 30 30 30 30 30
## $ COUNTYFP : Factor w/ 328 levels "001","003","005",..: 1 2 3 5 6 8 10 12 14 15
## $ COUNTYNS : Factor w/ 3233 levels "00023901","00025441",..: 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505
## $ AFFGEOID : Factor w/ 3233 levels "0500000US01001",..: 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774
## $ GEOID : Factor w/ 3233 levels "01001","01003",..: 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774
## $ NAME : chr "Belknap" "Carroll" "Cheshire" "Coos" ...
## $ LSAD : Factor w/ 11 levels "00","03","04",..: 5 5 5 5 5 5 5 5 5 5
## $ ALAND : Factor w/ 3233 levels "1000508842","1001064387",..: 67 1991 1424 2526 2494 1831 1997 1382 3172 730
## $ AWATER : Factor w/ 3233 levels "0","10017640",..: 778 638 2460 3097 55 1942 2454 1327 1852 1817
## $ Clinton : num 3495 3230 5132 2013 6918 ...
## $ Sanders : num 6005 5638 12441 3639 14245 ...
## $ SandersMarginVotes : num 2510 2408 7309 1626 7327 ...
## $ 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_POLYGON of length 10; first list element: List of 1
## ..$ : num [1:33, 1:2] -71.7 -71.7 -71.7 -71.7 -71.7 ...
## ..- attr(*, "class")= chr "XY" "POLYGON" "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 "STATEFP" "COUNTYFP" "COUNTYNS" "AFFGEOID" ...qtm(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")
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()## Warning in tm_style_classic(): tm_style_classic is deprecated as of tmap
## version 2.0. Please use tm_style("classic", ...) instead## 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.
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()## Warning in tm_style_classic(): tm_style_classic is deprecated as of tmap
## version 2.0. Please use tm_style("classic", ...) insteadnhstaticmap## 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.
save_tmap(nhstaticmap, filename="nhdemprimary.jpg")## Warning in save_tmap(nhstaticmap, filename = "nhdemprimary.jpg"): save_tmap
## is deprecated as of tmap version 2.0. Please use tmap_save instead## Warning in png(tmp, width = width, height = height, res = res): 'width=7,
## height=7' are unlikely values in pixels## Map saved to C:\Users\munis\Documents\Comm in Data Science\Week 9\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)
nhpopup <- paste0("<b>County: ", nhmap$NAME, "</b><br />Sanders ", percent(nhmap$SandersPct), " - Clinton ", percent(nhmap$ClintonPct))nhmap <- rename(nhmap, County = NAME)leaflet(nhmap) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup=nhpopup,
color= ~clintonPalette(nhmap$ClintonPct)
)## Warning: sf layer has inconsistent datum (+proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs).
## Need '+proj=longlat +datum=WGS84'nhmap_projected <- sf::st_transform(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)
)South Carolina data
scdata <- rio::import(scdatafile)scgeo <- dplyr::filter(usgeo, STATEFP==scfipscode)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")
} for(i in 1:nrow(scdata)){
scdata$winner[i] <- names(which.max(scdata[i,2:7]))
}sced <- rio::import("SCdegree.xlsx")str(scgeo$NAME)## Factor w/ 1921 levels "Abbeville","Acadia",..: 554 995 810 35 1073 523 1662 359 100 331 ...str(scdata$County)## chr [1:46] "Abbeville" "Aiken" "Allendale" "Anderson" "Bamberg" ...scgeo$NAME <- as.character(scgeo$NAME)scgeo <- scgeo[order(scgeo$NAME),]
scdata <- scdata[order(scdata$County),]identical(scgeo$NAME,scdata$County )## [1] TRUEscmap <- append_data(scgeo, scdata, key.data = "County", key.shp = "NAME")## Warning: This function is deprecated and has been migrated to github.com/
## mtennekes/oldtmaptools## Keys match perfectly.scmap <- rename(scmap, County = NAME)
scmap <- append_data(scmap, sced, key.shp = "County", key.data = "County")## Warning: This function is deprecated and has been migrated to github.com/
## mtennekes/oldtmaptools## Keys match perfectly.minpct <- min(c(scmap$Donald.J.TrumpPct, scmap$Marco.RubioPct , scmap$Ted.CruzPct))
maxpct <- max(c(scmap$Donald.J.TrumpPct, scmap$Marco.RubioPct , scmap$Ted.CruzPct))Create leaflet palettes for each layer of the map:
winnerPalette <- colorFactor(palette=c("#984ea3", "#e41a1c"), domain = scmap$winner)
trumpPalette <- colorNumeric(palette = "Purples", domain=c(minpct, maxpct))
rubioPalette <- colorNumeric(palette = "Reds", domain = c(minpct, maxpct))
cruzPalette <- colorNumeric(palette = "Oranges", domain = c(minpct, maxpct))
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: ", scmap$PctCollegeDegree, "% vs state-wide avg of 25%")scmap <- sf::st_transform(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"))scGOPmap2 <- 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(scmap$PctCollegeDegree),
group="College degs"
) %>%
addLayersControl(
baseGroups=c("Winners", "Trump", "Rubio", "Cruz", "College degs"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
) %>%
addSearchOSM()print(scGOPmap2)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")