In heike/electionViz: Visualizing US Polls and Election Results

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-",
  out.width = "100%"
)

electionViz

R package for visualizations of election (or poll) results as easy as adding geom_electoral_building. While the geom is still in the planning stages, several types of visualizations are implemented and ready to use.

Installation

The development version from GitHub with:

# install.packages("devtools")
devtools::install_github("heike/electionViz")

Example

We will be inundated with information about the state of the polls in the build-up to the upcoming Presidential election of 2020.

With the tools of this package you will be able to pick your favorite visualization(s) and explore the results your own way.

# load the package
library(electionViz)
library(tidyverse)

Hexbin Cartogram of Election Results by State

Each state is represented by one hexagon. This map has been made available by Andrew X Hill at CARTO.

data(elections)
el12 <- elections %>% filter(year == 2012)
gg12 <- hexplot(el12$state, el12$perc_rep > el12$perc_dem) +
  scale_fill_party("", labels=c("Democrat", "Republican")) +
  theme(legend.position = "bottom") +
  ggtitle("Election 2012")

el16 <- elections %>% filter(year == 2016)
gg16 <- hexplot(el16$state, el16$perc_rep > el16$perc_dem) +
  scale_fill_party("", labels=c("Democrat", "Republican")) +
  theme(legend.position = "bottom") +
  ggtitle("Election 2016")

gridExtra::grid.arrange(gg12, gg16, ncol=2)

Hexbin Cartogram of the US Presidential Election by Electoral Votes

Each state is represented by a set of hexagons corresponding in number to the state's electoral votes. This map was adapted from the object sf_FiveThirtyEightElectoralCollege in Bhaskar Karambelkar's R package tilegramsR.

# Merge geospatial and numerical information
electoral_hexplus <- electoral_hex %>%
  left_join(elections, by=c("state" = "state_po"))

# Make a first chloropleth map
electoral_hexplus %>%
  filter(year >= 2012) %>%
  mutate(
    Election = year,
    Outcome = c("Republican", "Democrat")[as.numeric(perc_rep < perc_dem) + 1]) %>%
  ggplot(aes(x = long, y = lat, group = group)) +
  geom_polygon(aes(fill =  Outcome), 
               colour = "grey60", size = 0.1, alpha = 0.9) +
  geom_text(aes(x = centerX, y = centerY, label = state), 
            colour = "grey90", size = 3, 
            data = unique(electoral_state_outline_hex[,c("centerX", "centerY", "state", "group")])) +
  geom_path(colour = "grey70", size = 0.35, 
            data = electoral_state_outline_hex) +
  theme_void() +
#  coord_map() +
  facet_wrap(~Election, labeller = "label_both") +
  theme(legend.position = "bottom") +
  ggtitle("US Presidential Election results by electoral votes") +
  scale_fill_party()

Electoral Building of the U.S. Presidential Election by Electoral Votes and Margin of Victory

"Electoral Building" diagram, inspired by a 2000 graphic from the New York Times. Vote margin is represented on the x axis, while number of electoral votes is represented in the height.

# make an electoral building plot! 
electoral_building(
    state_district = electoral_votes_2016$state_district, 
    electoral_votes = electoral_votes_2016$electoral_votes, 
    perc_dem = electoral_votes_2016$perc_dem, 
    perc_rep = electoral_votes_2016$perc_rep,
    source = "election") +
  scale_color_party("Party") +
  scale_fill_party("Party") +
  theme(legend.position = "bottom")

Visualization of Polls

Accessing data of the most recent polls from RealClearPolitics or FiveThirtyEight is done with functions rcp_update() or fivethirtyeight_update() respectively. Each one of these functions has a parameter polls to allow for a finer grained choice of which polls to focus on:

new_polls <- fivethirtyeight_update(polls="president_polls")
new_polls %>% filter(!is.na(state)) %>%
  select(poll_id, start_date, end_date, pollster, state, candidate_name, pct)

Polls by State

The difference in percentage between democratic and republican percentage of the last five polls (of likely or registered voters) for each state are shown as grey points, colored points show average difference for each point. States are ordered according to difference in percentage. The yellow rectangle shows a margin of +/- 5 percent - the typical margin of error of a poll.

library(lubridate)
state_polls <- new_polls %>% filter(
    !is.na(state),
    population %in% c("lv", "rv")) %>%
   polls_filter(method="last_k", k = 5)
#  polls_filter(method="since", since = today()-weeks(4))

state_1 <- state_polls %>%
  mutate(
    state = reorder(factor(state), pct_diff, mean)
  ) 

state_3 <- state_1 %>%
  polls_plus(electoral_votes_2016) %>%
  mutate(
    state = reorder(state, pct_diff, mean)
  )

state_1 <- state_1 %>%
  mutate(state = factor(state, levels = levels(state_3$state)))

gg_states <- state_1 %>%
  filter(!(state %in% c("Maine CD-1", "Maine CD-2", "Nebraska"))) %>%
  ggplot(aes(x = pct_diff, y = state)) + 
  geom_rect(xmin=-5, xmax=+5, ymin=-Inf, ymax = +Inf, 
            fill="#fcfcc5", size=0) + 
  geom_vline(xintercept = 0, colour = "grey10") + 
  geom_point(colour = "grey50", alpha = 0.35) +
  geom_text(aes(label=rank), colour = "grey30", size = 2) +
  theme_bw() +
  ylab("") +
  scale_y_discrete(drop=FALSE) 

gg_states +
  geom_point(aes(x = pct_diff, colour = pct_diff>0, shape=source),
             size = 2, data = state_3) +
  scale_colour_party("Party", labels=c("Democrat", "Republican")) +
  scale_x_continuous("Percent Difference", breaks=c(-60,-40,-20,0,20,40,60), 
                     limits=c(-60,60),
                     labels = c("←\nMore Democrat", "40","20",0,20, 40, "→\nMore Republican")) +
  theme(legend.position="bottom") +
  scale_shape_manual("Source", values = c(1, 19)) +
  ggtitle(sprintf("Polls of likely or registered voters, dates: %s to %s", min(state_1$end_date), max(state_1$end_date)))

Building of polls

state_3 <- state_3 %>% filter(!(state %in% c("Maine", "Nebraska")))
electoral_building(
    state_district = state_3$state, 
    electoral_votes = state_3$electoral_votes, 
    perc_dem = state_3$perc_dem, 
    perc_rep = state_3$perc_rep,
    source = state_3$source) +
  scale_color_party("Party") +
  scale_fill_party("Party") +
  theme(legend.position = "none") +
  ggtitle("Electoral building, based on polls")

A snake of beads

bead_snake_plot(
   electoral_votes_2016$state_district,
   electoral_votes_2016$electoral_votes,
   electoral_votes_2016$perc_dem,
   electoral_votes_2016$perc_rep, 
  height = 30, buffer = 3) +
  ggtitle("Election 2016")

bead_snake_plot(
  state_3$state, 
  state_3$electoral_votes,
  state_3$perc_dem, 
  state_3$perc_rep, 
  height = 30, buffer = 3) +
  ggtitle(sprintf("Polls %s", max(state_polls$end_date)))

state_3 %>%
  mutate(diff = perc_rep - perc_dem, 
         party = ifelse(perc_dem > perc_rep, "Dem", "Rep"),
         label = state) %>%
  ggsnake(order = diff, fill = diff, label = label, 
          color = party, size = electoral_votes) +
  scale_fill_party_binned() + 
  scale_color_party() +
  ggtitle(sprintf("Based on polls from %s to %s",
                  min(state_polls$end_date), 
                  max(state_polls$end_date)))