Comparing the performance of Elizabeth Warren and Beto O'Rourke

tale_two_cands.R

pacman::p_load(
  tidyverse,
  lubridate,
  snakecase,
  here,
  glue,
  fs
)

mid <- 3633
span <- "90d"
market <-
  read_csv(
    file = glue("https://www.predictit.org/Resource/DownloadMarketChartData?marketid={mid}&timespan={span}"),
    col_types = cols(
      ContractName = col_character(),
      Date = col_date("%m/%d/%Y %H:%M:%S %p"),
      OpenSharePrice = col_number(),
      HighSharePrice = col_number(),
      LowSharePrice = col_number(),
      CloseSharePrice = col_number(),
      TradeVolume = col_double()
    )
  ) %>%
  rename(
    name   = ContractName,
    date   = Date,
    open   = OpenSharePrice,
    high   = HighSharePrice,
    low    = LowSharePrice,
    close  = CloseSharePrice,
    volume = TradeVolume
  ) %>%
  mutate(name = to_snake_case(name))
  
polls <-
  read_html("http://bit.ly/2LdZIpm") %>%
  html_node("table.data:nth-child(2)") %>%
  html_table(fill = TRUE) %>%
  as_tibble(.name_repair = make_clean_names) %>%
  select(-spread) %>%
  slice(-1)

polls <- polls %>%
  gather(
    -poll, -date,
    key = "name",
    value = "points"
  ) %>%
  separate(
    col = date,
    into = c("start", "end"),
    sep = "\\s-\\s"
  ) %>%
  mutate(
    points = as.double(na_if(points, "--")),
    start = mdy(glue("{start}/19")),
    end = mdy(glue("{end}/19")),
    length = end - start
  ) %>%
  arrange(poll, start) %>%
  select(
    name,
    poll,
    points,
    start,
    end,
    length
  )

markets <- 
  bind_rows(
    read_csv("data/markets/2019-06-19_market.csv"),
    read_csv("data/markets/2019-07-10_markets.csv")
  ) %>% 
  distinct() %>% 
  arrange(date) %>% 
  select(date, name, close)

polling <- 
  bind_rows(
    read_csv("data/polling/2019-06-19_polls.csv"),
    read_csv("data/polling/2019-07-10_polls.csv")
  ) %>% 
  distinct() %>%
  mutate(points = as.double(na_if(points, "--"))/100) %>% 
  select(start, name, points) %>% 
  rename(date = start) %>% 
  arrange(date)

two_cands_market <- markets %>% 
  ggplot(aes(date, close)) +
  geom_line(
    data = markets %>% filter(name %out% c("warren", "o_rourke")),
    mapping = aes(group = name), 
    size = 0.25, 
    alpha = 0.25
  ) +
  geom_line(
    data = markets %>% filter(name %in% c("warren", "o_rourke")),
    mapping = aes(color = name), 
    size = 2
  ) +
  scale_color_manual(values = c("grey10", "springgreen4")) +
  scale_y_continuous(labels = scales::dollar) +
  labs(
    title = "A Tale of Two Candidates",
    subtitle = "Prediction Market $ Represents % Probability of Winning Nomination",
    x = "Date",
    y = "Closing Price",
    color = "Candidate",
    caption = "Source: PredictIt #3633"
  )

two_cands_poll <- polling %>% 
  ggplot(aes(date, points)) +
  geom_smooth(
    data = polling %>% filter(name %out% c("warren", "o_rourke")),
    mapping = aes(group = name), 
    color = "grey",
    size = 0.5, 
    alpha = 0.25,
    se = FALSE
  ) +
  geom_smooth(
    data = polling %>% filter(name %in% c("warren", "o_rourke")),
    mapping = aes(color = name, fill = name), 
    size = 2,
    se = TRUE
  ) +
  geom_point(
    data = polling %>% filter(name %in% c("warren", "o_rourke")),
    mapping = aes(color = name), 
    size = 2,
    alpha = 0.75
  ) +
  scale_color_manual(values = c("grey10", "springgreen4")) +
  scale_fill_manual(values = c("grey10", "springgreen4"), guide = FALSE) +
  scale_y_continuous(labels = scales::percent) +
  labs(
    title = "A Tale of Two Candidates",
    subtitle = "Share of Support Among Polling Sample",
    x = "Start Date",
    y = "Polling Support",
    color = "Candidate",
    caption = "Source: RealClearPolitics"
  )