R Notebook

library(tidyverse)
library(stringr)

states <- map_data("state")

Attaching package: ‘maps’

The following object is masked from ‘package:purrr’:

    map

Create percent a and b

states<-as.tibble(states) %>%
  mutate(state=region) %>%
  #group_by(state) %>% 
  mutate(percent_a = sample(1:15537)) %>% 
  mutate(percent_a = (percent_a/15537) * 100)

`as.tibble()` is deprecated, use `as_tibble()` (but mind the new semantics).
This warning is displayed once per session.

#dat<-states

---

Round percent_a

states<-states %>% 
  mutate(percent_a = round(percent_a, 2))

Create percent_b

states<-states %>% 
  mutate(percent_b = 100-round(percent_a, 2))

Map percentages

states %>% 
  ggplot() +
  geom_polygon(aes(x = long, y = lat, fill = percent_a, group = group), color = "white") + 
  coord_fixed(1.3) +
  guides(fill=FALSE) +
  theme_bw()# do this to leave off the color legend

Map binary outcomes variable + map

states %>% 
  mutate(winner = ifelse(percent_a > percent_b, "a", "b")) %>% 
  ggplot() +
  geom_polygon(aes(x = long, y = lat, fill = winner, group = group), color = "white") + 
  coord_fixed(1.3) +
  guides(fill=FALSE) +
  theme_bw()# do this to leave off the color legend

Now make a function to create the variables we want

create_map_vars<-function(x){x %>%
                  as.tibble(.) %>%
  mutate(state=region) %>%
  mutate(percent_a = sample(1:15537)) %>% #this creates the percentage for each row
  mutate(percent_a = (percent_a/15537) * 100)  %>% 
    mutate(percent_a=round(percent_a, 2)) %>% 
  mutate(percent_b = 100-(percent_a)) %>% 
  mutate(winner = ifelse(percent_a > percent_b, "a", "b")) %>% 
    mutate(margin_a = percent_a - percent_b)
  }

Apply this function to the data and Save it as ‘dat’

dat<-create_map_vars(map_data("state"))

Map binary winner outcome

  dat %>% 
  ggplot() +
  geom_polygon(aes(x = long, y = lat, fill = winner, group = group), color = "white") + 
  coord_fixed(1.3) +
  guides(fill=FALSE) +
  theme_bw()# do this to leave off the color legend

Make function to plot percentage

plot_percent<-function(x){x %>% 
  ggplot() +
  geom_polygon(aes(x = long, y = lat, fill = margin_a, group = group), color = "white") + #x = longitude 
  coord_fixed(1.3) +
  theme_bw()+
    scale_fill_gradient2(low="red", high="blue")+
    theme(legend.position = "false")}

This is basically a “random” result of a US federal election

plot_percent(dat)

---

With real data

---

Thankfully, a lot of people have taken the time to carefully document election results and make that data available to the public

Here I am importing data from the MIT xxxx project (website)

pres_dat<-read_csv("1976-2016-president.csv")

Create 2008 Winners dat

map_2008_dat<-pres_dat %>% select(year, state,candidate, party, state_votes=candidatevotes) %>% 
  filter(year==2008) %>% 
  unique() %>% 
  na.omit() %>% 
  group_by(state) %>% 
  mutate(state_total=sum(state_votes)) %>% 
  mutate(percent = round((state_votes / state_total) * 100, 2)) %>% 
  mutate(winner=ifelse(percent == max(percent), 1, 0)) %>% 
  filter(winner==1) %>% select(-winner)

Create 2012 Winners dat

map_2012_dat<-pres_dat %>% select(year, state,candidate, party, state_votes=candidatevotes) %>% 
  filter(year==2012) %>% 
  unique() %>% 
  na.omit() %>% 
  group_by(state) %>% 
  mutate(state_total=sum(state_votes)) %>% 
  mutate(percent = round((state_votes / state_total) * 100, 2)) %>% 
  mutate(winner=ifelse(percent == max(percent), 1, 0)) %>% 
  filter(winner==1) %>% select(-winner)

Create 2016 Winners dat

map_2016_dat<-pres_dat %>% select(year, state,candidate, party, state_votes=candidatevotes) %>% 
  filter(year==2016) %>% 
  unique() %>% 
  na.omit() %>% 
  group_by(state) %>% 
  mutate(state_total=sum(state_votes)) %>% 
  mutate(percent = round((state_votes / state_total) * 100, 2)) %>% 
  mutate(winner=ifelse(percent == max(percent), 1, 0)) %>% 
  filter(winner==1) %>% select(-winner)

winners_2008_dat<-map_2008_dat %>% arrange(year, state) %>% ungroup() %>%  mutate(state=tolower(state))

winners_2012_dat<-map_2012_dat %>% arrange(year, state) %>% ungroup() %>%  mutate(state=tolower(state))

winners_2016_dat<-map_2016_dat %>% arrange(year, state) %>% ungroup() %>%  mutate(state=tolower(state))

---

map_dat_2008<-merge(dat, winners_2008_dat, by="state")
map_dat_2012<-merge(dat, winners_2012_dat, by="state")
map_dat_2016<-merge(dat, winners_2016_dat, by="state")

---

For some reason, 2012 isn’t working correctly;

Fix 2012

map_dat_2012<-map_dat_2012 %>% mutate(party=ifelse(party=="democratic-farmer-labor", "democrat", party))

Make function to plot percentage

plot_percent<-function(x){x %>% 
  ggplot() +
  geom_polygon(aes(x = long, y = lat, fill = factor(party), group = group), color="white", alpha=0.75) + 
  coord_fixed(1.3) +
  theme_void()+
  scale_fill_manual(values=c("blue", "red"))+
  theme(legend.position = "false")}

Here we can plot each election seperately

plot_percent(map_dat_2008) + 
  ggtitle(2008) +
  theme(plot.title = element_text(size = 28, face = "bold", hjust=0.5))

#
plot_percent(map_dat_2012)+ 
  ggtitle(2012) +
  theme(plot.title = element_text(size = 28, face = "bold", hjust=0.5))

#
plot_percent(map_dat_2016)+ 
  ggtitle(2016) +
  theme(plot.title = element_text(size = 28, face = "bold", hjust=0.5))

n

dat_2008_2016<-bind_rows(map_dat_2008, map_dat_2012, map_dat_2016)

---

plot_percent(dat_2008_2016)+ 
  ggtitle("Presidential Elections: 2008 - 2016") +
  theme(plot.title = element_text(size = 28, face = "bold", hjust=0.5))+
  facet_wrap(~year, nrow = 3)+
  theme(strip.text.x = element_text(size = 20, colour = "black", face="bold"))

---

dat_2008_2016 %>% 
  arrange(percent) %>% 
  select(year, state, candidate, percent) %>%
  unique()

Look at margins

dat_2008_2016 %>% 
  filter(percent<90) %>% #This excludes DC (sorry, DC)
  arrange(percent) %>% 
  select(year, state, candidate, percent) %>%
  unique() %>% 
  ggplot(aes(x=year, y=percent))+
  geom_hline(yintercept = 50, alpha=0.2)+
  geom_jitter(size=3, alpha=0.5)+
  theme_bw()