player_comp_plot.R

library(tidyverse)

buzzes <- read_csv("~/Desktop/regs analysis/all_buzzes.csv")

tossups_heard <- read_csv("~/Desktop/regs analysis/tossups_heard.csv") %>% 
  filter(!is.na(Packet)) %>% 
  group_by(Packet) %>% 
  summarize(Heard = max(Heard))

tossups <- buzzes %>% 
  group_by(Answer, Packet) %>% 
  count(value) %>% 
  spread(value, n, fill = 0) %>% 
  select(Answer, Packet, Correct = `10`, Neg = `–5`) %>% 
  left_join(tossups_heard) %>% 
  mutate(conv_pct = min(Correct/Heard,1),
         neg_pct = Neg/Heard)
  

all_buzz_pts <- tibble(Answer = rep(unique(buzzes$Answer), 100),
                       n = 0) %>% 
  group_by(Answer) %>% 
  mutate(buzz_pct = row_number())

tossup_buzz_pts <- buzzes %>% 
  filter(value == 10) %>% 
  count(Answer, buzz_pct)

tossup_buzz_graph <- anti_join(all_buzz_pts, tossup_buzz_pts, by = c("Answer", "buzz_pct")) %>% 
  bind_rows(tossup_buzz_pts) %>% 
  mutate(buzz_decile = as.factor(ifelse(buzz_pct == 100, 100, cut(buzz_pct, seq(0,100,10))))) %>% 
  unique() %>% 
  left_join(select(buzzes, Answer, Packet, Category, Subcategory)) %>% 
  unique() %>% 
  group_by(Answer) %>% 
  arrange(buzz_pct) %>% 
  left_join(tossups) %>% 
  mutate(total_buzz = cumsum(n),
         conversion = total_buzz/Heard)

science_teams <- c("Chicago A", "Penn A", "Columbia A", "Northwestern A", "Berkeley A")

buzzes %>% 
  filter(Team %in% science_teams, value == 10) %>% 
  select(Answer, Team, Player, buzz_pct) %>% 
  right_join(tossup_buzz_graph) %>% 
  filter(Category == "Science") %>%
  mutate(Player = case_when(is.na(Player) ~ "Other", 
                            TRUE ~ Player),
         Team = case_when(is.na(Team) ~ "Other", 
                            TRUE ~ Team)) %>%
  group_by(Packet) %>% 
  mutate(comp = length(unique(Team))) %>% 
  filter(comp > 1) %>%
  ungroup() %>% 
  group_by(Category, buzz_pct, Answer, Team, Player) %>% 
  summarize(conv = sum(total_buzz)/sum(Heard)) %>% 
  ggplot() +
  geom_col(aes(x = buzz_pct, y = conv, fill = Team), width = 1) +
  geom_text(aes(x = buzz_pct, y = -.1, label = ifelse(Player == "Other", "", substr(Player,1,1)), color = Team), size = 2.5) +
  facet_wrap(~Answer) +
  scale_y_continuous(labels = scales::percent, limits = c(-0.15,1)) +
  labs(title = "Top Teams on Science",
       x = "% of Question Elapsed", 
       y = "% of Rooms with a correct buzz") +
  scale_fill_manual(values = c("Penn A" = "#0018A8",
                               "Columbia A" = "#0087BD",
                               "Northwestern A" = "purple",
                               "Chicago A" = "maroon",
                               "Berkeley A" = "#DAA520",
                               "Other" = "gray")) +
  scale_color_manual(values = c("Penn A" = "#0018A8",
                                "Columbia A" = "#0087BD",
                                "Northwestern A" = "purple",
                                "Berkeley A" = "#DAA520",
                                "Chicago A" = "maroon",
                                "Other" = "gray")) +
  theme_bw()