NBA Draft GrindingtheMocks

2020 NBA Draft Consensus Ranks - Ranks.csv

analysis.R

library(tidyverse)
library(janitor)
library(lme4)
library(brms)
library(hrbrthemes)
library(parallel)
library(rstan)
library(ggridges)

options(
  buildtools.check = function(action)
    TRUE
)
rstan_options(auto_write = TRUE)
options(mc.cores = detectCores())

read_csv("https://gist.githubusercontent.com/benjaminrobinson/e9b4b259dfe5026174fcc961e3eb89c5/raw/6c2ae06a0ee2ff5f0ca82fd60871061c07b77bbd/2020%2520NBA%2520Draft%2520Consensus%2520Ranks%2520-%2520Ranks.csv") -> tmp

bind_rows(
  tmp %>%
    select(contains("X"), contains("Mock")) %>%
    setNames(.[1, ]) %>%
    slice(-1) %>%
    gather(author, rank,-name,-url) %>%
    mutate(type = 'Mock'),
  tmp %>%
    select(contains("X"), contains("Analyst")) %>%
    setNames(.[1, ]) %>%
    slice(-1) %>%
    gather(author, rank,-name,-url) %>%
    mutate(type = 'Analyst'),
  tmp %>%
    select(contains("X"), contains("Model")) %>%
    setNames(.[1, ]) %>%
    slice(-1) %>%
    gather(author, rank,-name,-url) %>%
    mutate(type = 'Model')
) %>%
  filter(!is.na(rank)) %>%
  mutate(rank = as.numeric(rank),
         draft_weight = 1) %>%
  arrange(name, type, rank) -> dat

dat %>%
  group_by(name) %>%
  mutate(avg = mean(rank)) %>%
  ungroup %>%
  mutate(avg_rank = dense_rank(avg),
         name = fct_reorder(
           .f = name,
           .x = rank,
           .fun = mean,
           .desc = TRUE
         )) %>%
  arrange(avg_rank) %>%
  filter(avg_rank <= 14) %>%
  ggplot(aes(x = rank, y = name, alpha = .75)) +
  geom_density_ridges(show.legend = FALSE) +
  scale_x_continuous(breaks = c(1, 5, 10, 15, 20, 25), limits = c(1, 25)) +
  coord_cartesian(clip = "off") +
  theme_ipsum() +
  labs(
    x = 'Pre-Draft Ranking',
    y = 'NBA Draft Prospect (Arranged by Average Pre-Draft Ranking)',
    caption = "Chart by @benj_robinson | Data by @jessefischer33",
    title = "Wisdom of the Crowd's Projected Lottery Picks"
  )

lmer(data = dat,
     formula = rank ~ (1 | name)) -> mod

brm(rank ~ (1 | name),
    data = dat,
    algorithm = 'meanfield',
    family = cumulative(link_disc = "log")) -> bayes

dat %>%
  distinct(name) %>%
  bind_cols(edp = predict(object = bayes,
                          newdata = dat %>%
                            distinct(name)) %>%
              as.data.frame %>%
              clean_names) -> edp

edp %>%
  gather(number, pick, -name) %>%
  mutate(number = gsub("p_y_", "", number) %>% as.numeric) %>%
  filter(number <= 14) %>%
  filter(pick > 0) %>%
  mutate(pick_number = factor(number, levels = sort(unique(number))),
         name = fct_reorder(
           .f = name,
           .x = pick,
           .fun = max
         )) %>%
  arrange(desc(name)) %>%
  group_by(name) %>%
  mutate(avg = max(pick[number == 1])) %>%
  ungroup %>%
  mutate(rank = dense_rank(-avg)) %>%
  filter(rank <= 14) %>%
  ggplot(aes(x = pick_number, y = name, fill = pick)) +
  geom_tile() +
  scale_fill_viridis_b() +
  labs(
    x = "Pick Number",
    y = "NBA Draft Prospect",
    fill = "Pick Probability",
    caption = "Chart by @benj_robinson | Data by @jessefischer33",
    title = "Bayes-in it Up - NBA Draft Mock Draft Madness"
  ) +
  theme_ipsum()

edp %>%
  gather(number, pick, -name) %>%
  mutate(number = gsub("p_y_", "", number) %>% as.numeric) %>%
  filter(pick > 0) %>%
  filter(name == 'Deni Avdija') %>%
  mutate(cum = cumsum(pick)) %>%
  filter(cum <= .75) %>%
  gather(key, value, -name, -number) %>%
  ggplot(aes(x = number, y = value, fill = key)) +
  geom_bar(stat = 'identity', show.legend = FALSE, position = 'dodge') +
  scale_x_reverse(breaks = c(1:15)) +
  scale_y_percent() +
  coord_flip() +
  theme_ipsum() +
  labs(
    x = "Draft Pick",
    y = "Probability Density",
    title = "Deni Avdija's Pick by Pick Probability of Draft Selection",
    caption = "Chart by @benj_robinson | Data by @jessefischer33"
  ) +
  scale_fill_manual(values = c("#1d428a", "#c8102e"))

library(tidybayes)
dat %>%
  distinct(name) %>%
  add_fitted_draws(bayes)