APratt MT_election

library(tidyverse)
library(leaflet)
library(sf)
library(readxl)
library(DT)
library(plotly)
library(broom)
library(tidycensus)

census_api_key("869f0f8db207fe77c709b9b24681536a0abc2956")

To install your API key for use in future sessions, run this function with `install = TRUE`.

senate_counties <- read_xlsx("Statewide Results.xlsx", sheet = 1)

New names:
* `` -> ...2
* `` -> ...3
* `` -> ...4
* `` -> ...5

senate_counties <- read_xlsx("Statewide Results.xlsx", sheet = 1, range = "B7:E63")

senate_counties <- senate_counties %>% 
  rename(Republican = "MATT ROSENDALE\r\nRepublican") %>% 
  rename(Democrat = "JON TESTER\r\nDemocrat") %>% 
  rename(Libertarian = "RICK BRECKENRIDGE\r\nLibertarian")

senate_counties <- senate_counties %>% 
  mutate(total_votes = Republican + Democrat + Libertarian) %>% 
  mutate(Repub_advantage = Republican/total_votes - Democrat/total_votes) %>% 
  mutate(Repub_advantage = round(Repub_advantage*100, 1))

senate_counties %>% 
  arrange(-Repub_advantage)

First, let’s find the Republican Advantage.

mt_counties <- get_acs(geography = "county",
                       variables = "B01003_001",
                       state = "MT",
                       geometry = TRUE) 

Getting data from the 2014-2018 5-year ACS
Downloading feature geometry from the Census website.  To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
Using FIPS code '30' for state 'MT'

senate_counties[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_counties)

Joining, by = "County"

senate_election %>%
  as_tibble() %>% 
  select(County, Population, Democrat, Republican, Libertarian, total_votes, Repub_advantage) %>% 
  datatable()

And then clean it up.

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)

sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
Need '+proj=longlat +datum=WGS84'

Here is a choropleth map of the same data; the colors go from purple to yellow, which represent lowest to highest Republican advantage, respectfully.

sen_pop_model <- lm(Repub_advantage ~ Population, data = senate_election)
tidy(sen_pop_model)

glance(sen_pop_model)

Here are some slick statistics showing the hypothesis is confirmed.

pop_model <- lm(Repub_advantage ~ Population, data = senate_election)

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(marker = list(opacity = 0.7), showlegend = F) %>%
  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)) 

Same information #(higher populations offer less Republican advantage.)

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)

st_centroid does not give correct centroids for longitude/latitude datast_centroid does not give correct centroids for longitude/latitude data

sen_longitude_lm <- lm(Repub_advantage ~ Longitude, data = senate_election)
tidy(sen_longitude_lm)

glance(sen_longitude_lm)

Here are the statistics based of location rather than population (since the second part of the hypothesis is West vs East Republican advantage).

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(sen_longitude_lm))

I want to overlay this graph on a map of Montana.

sen_multiple_lm <- lm(Repub_advantage ~ Population + Longitude, data = senate_election)
tidy(sen_multiple_lm)

glance(sen_multiple_lm)

These statistics show that roughly 27% of the vote variance comes from the location and the population.

senate_election %>% 
  plot_ly(x = ~Longitude, y = ~Population, z = ~Repub_advantage, 
          text = ~County, hoverinfo = "text") %>% 
  add_markers(opacity = .7, showlegend = F)

Here’s a 3-D plot that addresses the data we have with multiple regression lines to explore the correlations between location and population. The hypothesis has been proven accurate.