Skip to content

Instantly share code, notes, and snippets.

@heidekrueger
Last active November 6, 2020 11:32
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save heidekrueger/e08a23c9225972fa9920c4b44108a411 to your computer and use it in GitHub Desktop.
Save heidekrueger/e08a23c9225972fa9920c4b44108a411 to your computer and use it in GitHub Desktop.
R Code to generate plot for uncalled races (as of 4pm EST on Thursday)
# Based on snippet by @charlie7whiskey https://gist.github.com/cgrilson7/86737d3b07c2a0806f8aaeaaedf2fd7c
# Via unofficial NYT api at https://github.com/alex/nyt-2020-election-scraper
#updated 11/6 after api change
library(tidyverse)
library(rvest)
library(lubridate)
url <- "https://alex.github.io/nyt-2020-election-scraper/battleground-state-changes.html"
tables_raw <- read_html(url) %>%
html_nodes("table") %>%
html_table(fill = TRUE)
tables <- tables_raw %>%
map(function(t){
state <- t[1,1] %>% str_match("(^.*)\\s\\(") %>% .[,2]
new_names <- unlist(t[2,])
t %>% set_names(new_names) %>% select(-9) %>% slice(-c(1,2)) %>% mutate(State = state) %>% as_tibble
}) %>%
bind_rows() %>%
as_tibble() %>%
select(State, Timestamp, Leader = `In The Lead`, Lead = `Vote Differential`, Remaining = `Votes Remaining (est.)`) %>%
mutate(Timestamp = as.POSIXct(Timestamp, tz = "UTC")) %>%
mutate(across(c(Lead, Remaining), ~as.numeric(gsub(',', '', .)))) %>%
# add features
mutate(trump_lead = ifelse(Leader == "Trump", Lead, -Lead)) %>%
# manually determine order of facets
#mutate(State = factor(State, levels = c("Pennsylvania", "North Carolina", "Alaska", "Georgia", "Nevada", "Arizona"))) %>%
filter(
State %in% c("Pennsylvania", "Georgia", "Arizona", "Nevada"),
Timestamp >= as_datetime("2020-11-05 06:00:00")
)
tables %>%
ggplot(aes(x = Remaining, y = trump_lead, group=State)) +
geom_path(color = "gray", size = 0.5) +
geom_point(aes(col = Timestamp), fill = "#041E42", size = 1) +
geom_text(
data = tables %>%
group_by(State) %>%
filter(row_number() %% 15 == 0 | Timestamp == max(Timestamp) | Timestamp == min(Timestamp)) %>%
ungroup(),
aes(label = format(Timestamp, "%a %H:%M", tz = "EST")), angle = 45, color = '#041E42', hjust = -0.1) +
facet_wrap(~State, scales='free', ncol = 2) +
scale_x_continuous(labels = scales::number, trans = 'reverse', limits = c(NA, 0)) +
scale_color_viridis_c(trans = "time") +
geom_hline(yintercept = 0, color = '#041E42') +
geom_vline(xintercept = 0, color = 'red') +
theme_minimal()+
xlab("NYT Estimated Votes Remaining") +
ylab("Trump Vote Lead") +
geom_hline(yintercept = 0, color = '#041E42') +
ggtitle("Uncalled Races", subtitle = paste0(
"Source: Unofficial NYTimes Votes Remaining API\nCreator: @hdkrgr based on code by @charlie7whiskey\nUpdated: ", format(Sys.time(), tz = "EST", '%H:%M EST'))
) +
theme_minimal() +
theme(text = element_text(),
#legend.position = 'none',
axis.title = element_text(size = 18),
strip.text = element_text(face = 'bold', size = 12),
plot.title = element_text(face = 'bold', size = 18, color = '#041E42')
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment