library(tidyverse)
draft_pick_sim <- function(n_teams = 30, n_groups = 2, n_sims = 100) {
old <- 1:n_teams
sims <- replicate(n_sims, sample(1:n_groups, n_teams, replace = T)) %>%
as_tibble(.name_repair = "unique") %>%
bind_cols(tibble(old)) %>%
gather(sim, outcome, -old) %>%
group_by(sim) %>%
arrange(sim, outcome, old) %>%
mutate(new = row_number())
return(sims)
}A Modified Draft Pick Selection Order
r
riddler
In preparation for teaching a new computing course for the social sciences, I’ve been practicing building interactive websites using Shiny for R. The latest Riddler puzzle from FiveThirtyEight was an especially interesting challenge, combining aspects of computational simulation and Shiny programing:
You are one of 30 team owners in a professional sports league. In the past, your league set the order for its annual draft using the teams’ records from the previous season — the team with the worst record got the first draft pick, the team with the second-worst record got the next pick, and so on. However, due to concerns about teams intentionally losing games to improve their picks, the league adopts a modified system. This year, each team tosses a coin. All the teams that call their coin toss correctly go into Group A, and the teams that lost the toss go into Group B. All the Group A teams pick before all the Group B teams; within each group, picks are ordered in the traditional way, from worst record to best. If your team would have picked 10th in the old system, what is your expected draft position under the new system?
Extra credit: Suppose each team is randomly assigned to one of T groups where all the teams in Group 1 pick, then all the teams in Group 2, and so on. (The coin-flipping scenario above is the case where T = 2.) What is the expected draft position of the team with the Nth-best record?
One could go the analytical route to solve this, but I wanted to take a computational, brute-force approach. This type of problem is ripe for Markov chain Monte Carlo (MCMC) methods, which I’ve use before in Riddler solutions.
The main task is to write a function that calculates the new draft position for a team given their current draft pick and potential assignment into one of \(K\) groups. The function I wrote is:
For each simulation, I randomly sample each team into one of n_groups, then calculate draft order from worst-to-first within each group and then between groups. From this I can then calculate the expected draft position for each team given their original draft order.
So given the original problem setup, the expected draft positions for each team given random assignment into one of two groups is:
draft_pick_sim(n_sims = 10000) %>%
group_by(old) %>%
summarize(mean = mean(new)) %>%
knitr::kable(
caption = "Expected Draft Position (based on 10,000 simulations)",
col.names = c("Original Draft Position", "Expected Draft Position")
)| Original Draft Position | Expected Draft Position |
|---|---|
| 1 | 8.354 |
| 2 | 8.775 |
| 3 | 9.214 |
| 4 | 9.635 |
| 5 | 10.264 |
| 6 | 10.676 |
| 7 | 11.257 |
| 8 | 11.742 |
| 9 | 12.201 |
| 10 | 12.768 |
| 11 | 13.206 |
| 12 | 13.751 |
| 13 | 14.349 |
| 14 | 14.650 |
| 15 | 15.168 |
| 16 | 15.653 |
| 17 | 16.285 |
| 18 | 16.794 |
| 19 | 17.242 |
| 20 | 17.735 |
| 21 | 18.203 |
| 22 | 18.752 |
| 23 | 19.284 |
| 24 | 19.799 |
| 25 | 20.361 |
| 26 | 20.812 |
| 27 | 21.210 |
| 28 | 21.700 |
| 29 | 22.442 |
| 30 | 22.720 |
The team originally with the 10th draft can expect to have the 13th pick under this new approach.
What turned into the more complicated part was turning this function into a working Shiny app. I encourage you to try it out, as it generalizes the problem by providing expected draft picks given \(N\) teams and \(K\) groups.
Session Info
─ Session info ───────────────────────────────────────────────────────────────
setting value
version R version 4.6.1 (2026-06-24)
os macOS Tahoe 26.6.1
system aarch64, darwin23
ui X11
language (EN)
collate en_US.UTF-8
ctype en_US.UTF-8
tz America/New_York
date 2026-08-12
pandoc 3.10 @ /Applications/Positron.app/Contents/Resources/app/quarto/bin/tools/aarch64/ (via rmarkdown)
quarto 1.10.18 @ /Applications/quarto/bin/quarto
─ Packages ───────────────────────────────────────────────────────────────────
! package * version date (UTC) lib source
P cli 3.6.6 2026-04-09 [?] RSPM
P codetools 0.2-20 2024-03-31 [?] CRAN (R 4.6.1)
P digest 0.6.39 2025-11-19 [?] RSPM
P dplyr * 1.2.1 2026-04-03 [?] RSPM
P evaluate 1.0.5 2025-08-27 [?] RSPM
P farver 2.1.2 2024-05-13 [?] RSPM
P fastmap 1.2.0 2024-05-15 [?] RSPM
P forcats * 1.0.1 2025-09-25 [?] RSPM
P generics 0.1.4 2025-05-09 [?] RSPM
P ggplot2 * 4.0.3 2026-04-22 [?] RSPM
P glue 1.8.1 2026-04-17 [?] RSPM
P gtable 0.3.6 2024-10-25 [?] RSPM
P hms 1.1.4 2025-10-17 [?] RSPM
P htmltools 0.5.9 2025-12-04 [?] RSPM
P jsonlite 2.0.0 2025-03-27 [?] RSPM
P knitr 1.51 2025-12-20 [?] RSPM
P lifecycle 1.0.5 2026-01-08 [?] RSPM
P lubridate * 1.9.5 2026-02-04 [?] RSPM
P magrittr 2.0.5 2026-04-04 [?] RSPM
P otel 0.2.0 2025-08-29 [?] RSPM
P pillar 1.11.1 2025-09-17 [?] RSPM
P pkgconfig 2.0.3 2019-09-22 [?] RSPM
P purrr * 1.2.2 2026-04-10 [?] RSPM
P R6 2.6.1 2025-02-15 [?] RSPM
P ragg 1.5.2 2026-03-23 [?] RSPM
P RColorBrewer 1.1-3 2022-04-03 [?] RSPM
P readr * 2.2.0 2026-02-19 [?] RSPM
renv 1.2.4 2026-08-03 [1] RSPM (R 4.6.0)
P rlang 1.3.0 2026-07-05 [?] RSPM
P rmarkdown 2.31 2026-03-26 [?] RSPM
P S7 0.2.2 2026-04-22 [?] RSPM
P scales 1.4.0 2025-04-24 [?] RSPM
P sessioninfo 1.2.4 2026-06-04 [?] RSPM
P stringi 1.8.9 2026-08-04 [?] RSPM
P stringr * 1.6.0 2025-11-04 [?] RSPM
P systemfonts 1.3.2 2026-03-05 [?] RSPM
P textshaping 1.0.5 2026-03-06 [?] RSPM
P tibble * 3.3.1 2026-01-11 [?] RSPM
P tidyr * 1.3.2 2025-12-19 [?] RSPM
P tidyselect 1.2.1 2024-03-11 [?] RSPM
P tidyverse * 2.0.0 2023-02-22 [?] RSPM
P timechange 0.4.0 2026-01-29 [?] RSPM
P tzdb 0.5.0 2025-03-15 [?] RSPM
P vctrs 0.7.3 2026-04-11 [?] RSPM
P withr 3.0.3 2026-06-19 [?] RSPM
P xfun 0.60 2026-07-09 [?] RSPM
P yaml 2.3.12 2025-12-10 [?] RSPM
[1] /Users/bcs88/Projects/personal-site/renv/library/macos/R-4.6/aarch64-apple-darwin23
[2] /Users/bcs88/Library/Caches/org.R-project.R/R/renv/sandbox/macos/R-4.6/aarch64-apple-darwin23/46003b10
* ── Packages attached to the search path.
P ── Loaded and on-disk path mismatch.
──────────────────────────────────────────────────────────────────────────────