Assignment: 2016 US Senate Montana election: Tester/Rosendale
The Senate election may be an even better test of these two hypotheses, because the election was even closer to 50-50, but this time Tester the Democrat won.
Run through the senate election as we did above with the house election. You can get the data from the same spreadsheet, but it’s on sheet = 1.
Packages:
library(tidyverse)## ── Attaching packages ─────────────────────────────────────────────── tidyverse 1.2.1 ──## ✔ ggplot2 3.1.1 ✔ purrr 0.3.2
## ✔ tibble 2.1.1 ✔ dplyr 0.8.0.1
## ✔ tidyr 0.8.3 ✔ stringr 1.4.0
## ✔ readr 1.3.1 ✔ forcats 0.4.0## ── Conflicts ────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(leaflet)
library(sf)## Linking to GEOS 3.5.1, GDAL 2.1.3, PROJ 4.9.2library(readxl)
library(DT)
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':
##
## layoutlibrary(broom)
library(tidycensus)Read data:
senate_election <- read_xlsx("Statewide Results.xlsx", sheet = 1, range = "B7:E63")
glimpse(senate_election)## Observations: 56
## Variables: 4
## $ County <chr> "Beaverhead", "Big Horn", "Bl…
## $ `JON TESTER\r\nDemocrat` <dbl> 1876, 3027, 1961, 1071, 2680,…
## $ `MATT ROSENDALE\r\nRepublican` <dbl> 2866, 1558, 982, 2086, 3209, …
## $ `RICK BRECKENRIDGE\r\nLibertarian` <dbl> 155, 91, 76, 104, 178, 22, 10…Change name:
senate_election <- senate_election %>%
rename(Democrat = "JON TESTER\r\nDemocrat") %>%
rename(Republican = "MATT ROSENDALE\r\nRepublican") %>%
rename(Libertarian = "RICK BRECKENRIDGE\r\nLibertarian")
glimpse(senate_election)## Observations: 56
## Variables: 4
## $ County <chr> "Beaverhead", "Big Horn", "Blaine", "Broadwater", "C…
## $ Democrat <dbl> 1876, 3027, 1961, 1071, 2680, 128, 17435, 1275, 1942…
## $ Republican <dbl> 2866, 1558, 982, 2086, 3209, 602, 15566, 1312, 2762,…
## $ Libertarian <dbl> 155, 91, 76, 104, 178, 22, 1008, 70, 179, 29, 140, 1…The Republican - Democrat difference in each county:
senate_election <- senate_election %>%
mutate(total_votes = Republican + Democrat + Libertarian) %>%
mutate(Repub_advantage = Republican/total_votes - Democrat/total_votes) %>%
mutate(Repub_advantage = round(Repub_advantage*100, 1))
senate_election %>%
arrange(-Repub_advantage)Get census data:
mt_counties <- get_acs(geography = "county",
variables = "B01003_001",
state = "MT",
geometry = TRUE) ## Getting data from the 2013-2017 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|==== | 7%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|====== | 10%
|
|======= | 10%
|
|======= | 11%
|
|======== | 12%
|
|======== | 13%
|
|========= | 13%
|
|========= | 14%
|
|========== | 15%
|
|========== | 16%
|
|=========== | 16%
|
|=========== | 17%
|
|=========== | 18%
|
|============ | 18%
|
|============ | 19%
|
|============= | 19%
|
|============= | 20%
|
|============= | 21%
|
|============== | 21%
|
|============== | 22%
|
|=============== | 22%
|
|=============== | 23%
|
|=============== | 24%
|
|================ | 24%
|
|================ | 25%
|
|================= | 25%
|
|================= | 26%
|
|================= | 27%
|
|================== | 27%
|
|================== | 28%
|
|=================== | 29%
|
|=================== | 30%
|
|==================== | 30%
|
|==================== | 31%
|
|===================== | 32%
|
|===================== | 33%
|
|====================== | 33%
|
|====================== | 34%
|
|====================== | 35%
|
|======================= | 35%
|
|======================= | 36%
|
|======================== | 36%
|
|======================== | 37%
|
|======================== | 38%
|
|========================= | 38%
|
|========================= | 39%
|
|========================== | 39%
|
|========================== | 40%
|
|========================== | 41%
|
|=========================== | 41%
|
|=========================== | 42%
|
|============================ | 42%
|
|============================ | 43%
|
|============================ | 44%
|
|============================= | 44%
|
|============================= | 45%
|
|============================== | 45%
|
|============================== | 46%
|
|============================== | 47%
|
|=============================== | 47%
|
|=============================== | 48%
|
|================================ | 48%
|
|================================ | 49%
|
|================================ | 50%
|
|================================= | 50%
|
|================================= | 51%
|
|================================= | 52%
|
|================================== | 52%
|
|================================== | 53%
|
|=================================== | 53%
|
|=================================== | 54%
|
|==================================== | 55%
|
|==================================== | 56%
|
|===================================== | 56%
|
|===================================== | 57%
|
|===================================== | 58%
|
|====================================== | 58%
|
|====================================== | 59%
|
|======================================= | 59%
|
|======================================= | 60%
|
|======================================= | 61%
|
|======================================== | 61%
|
|======================================== | 62%
|
|========================================= | 62%
|
|========================================= | 63%
|
|========================================= | 64%
|
|========================================== | 64%
|
|========================================== | 65%
|
|=========================================== | 65%
|
|=========================================== | 66%
|
|=========================================== | 67%
|
|============================================ | 67%
|
|============================================ | 68%
|
|============================================= | 69%
|
|============================================= | 70%
|
|============================================== | 70%
|
|============================================== | 71%
|
|=============================================== | 72%
|
|=============================================== | 73%
|
|================================================ | 73%
|
|================================================ | 74%
|
|================================================ | 75%
|
|================================================= | 75%
|
|================================================= | 76%
|
|================================================== | 76%
|
|================================================== | 77%
|
|================================================== | 78%
|
|=================================================== | 78%
|
|=================================================== | 79%
|
|==================================================== | 79%
|
|==================================================== | 80%
|
|==================================================== | 81%
|
|===================================================== | 81%
|
|===================================================== | 82%
|
|====================================================== | 82%
|
|====================================================== | 83%
|
|====================================================== | 84%
|
|======================================================= | 84%
|
|======================================================= | 85%
|
|======================================================== | 85%
|
|======================================================== | 86%
|
|======================================================== | 87%
|
|========================================================= | 87%
|
|========================================================= | 88%
|
|========================================================== | 88%
|
|========================================================== | 89%
|
|========================================================== | 90%
|
|=========================================================== | 90%
|
|=========================================================== | 91%
|
|=========================================================== | 92%
|
|============================================================ | 92%
|
|============================================================ | 93%
|
|============================================================= | 93%
|
|============================================================= | 94%
|
|============================================================= | 95%
|
|============================================================== | 95%
|
|============================================================== | 96%
|
|=============================================================== | 96%
|
|=============================================================== | 97%
|
|=============================================================== | 98%
|
|================================================================ | 98%
|
|================================================================ | 99%
|
|=================================================================| 99%
|
|=================================================================| 100%Join the two datasets:
senate_election[25, "County"] <- "Lewis and Clark"
mt_counties <- mt_counties %>%
mutate(County = gsub(" County, Montana", "", NAME)) %>%
rename(Population = estimate)
senate_election <- mt_counties %>%
full_join(senate_election)## Joining, by = "County"Displaying results:
senate_election %>%
as_tibble() %>%
select(County, Population, Democrat, Republican, Libertarian, total_votes, Repub_advantage) %>%
datatable()Montana counties choropleth:
vote_colors <- colorNumeric(palette = "viridis", domain = senate_election$Repub_advantage)
senate_election %>%
leaflet() %>%
addTiles() %>%
addPolygons(weight = 1,
fillColor = ~vote_colors(Repub_advantage),
label = ~paste0(County, ", Republican advantage = ", Repub_advantage),
highlight = highlightOptions(weight = 2)) %>%
setView(-110, 47, zoom = 6) %>%
addLegend(pal = vote_colors, values = ~Repub_advantage)## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'linear regression:
pop_model_se <- lm(Repub_advantage ~ Population, data = senate_election)
tidy(pop_model_se)glance(pop_model_se)senate_election %>%
plot_ly(x = ~Population,
y = ~Repub_advantage,
hoverinfo = "text",
text = ~paste("County:",
County, "<br>",
"Population: ", Population, "<br>",
"Republican advantage: ", Repub_advantage)) %>%
add_markers(showlegend = F, marker = list(opacity = 0.7)) %>%
layout(title = "Predicting Republican Vote Advantage from Population, by County",
xaxis = list(title = "County population"),
yaxis = list(title = "Republican vote advantage")) %>%
add_lines(y = ~fitted(pop_model_se))senate_election <- senate_election %>%
mutate(Longitude = as_tibble(st_coordinates(st_centroid(senate_election$geometry)))$X) %>%
mutate(Latitude = as_tibble(st_coordinates(st_centroid(senate_election$geometry)))$Y)## Warning in st_centroid.sfc(senate_election$geometry): st_centroid does not
## give correct centroids for longitude/latitude data
## Warning in st_centroid.sfc(senate_election$geometry): st_centroid does not
## give correct centroids for longitude/latitude datasenate_election %>%
leaflet() %>%
addTiles() %>%
addPolygons(weight = 1) %>%
setView(-110, 47, zoom = 6) %>%
addCircleMarkers(~Longitude, ~Latitude)## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'The linear regression:
longitude_lm_se <- lm(Repub_advantage ~ Longitude, data = senate_election)
tidy(longitude_lm_se)glance(longitude_lm_se)Graph:
senate_election %>%
plot_ly(x = ~Longitude,
y = ~Repub_advantage,
hoverinfo = "text",
text = ~paste("County:", County, "<br>", "Longitude: ", Longitude, "<br>", "Republican advantage: ", Repub_advantage)) %>%
add_markers(marker = list(opacity = 0.7), showlegend = F) %>%
layout(title = "Predicting Republican Vote Advantage from Longitude, by County",
xaxis = list(title = "County longitude"),
yaxis = list(title = "Republican vote advantage")) %>%
add_lines(y = ~fitted(longitude_lm_se))Multiple regression to predict the Republican advantage from both Population and Longitude simultaneously:
multiple_lm_se <- lm(Repub_advantage ~ Population + Longitude, data = senate_election)
tidy(multiple_lm_se)glance(multiple_lm_se)Graph:
senate_election %>%
plot_ly(x = ~Longitude, y = ~Population, z = ~Repub_advantage,
text = ~County, hoverinfo = "text") %>%
add_markers(opacity = .7, showlegend = F)