Created
March 19, 2024 12:06
-
-
Save kylebutts/4af4134ab47be9bee4470bdad0d16b4d to your computer and use it in GitHub Desktop.
Simulation of "Surpised by the Hot Hand Fallacy" Econometrica
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(tidyverse) | |
# %% | |
simulation <- function(n, p, k) { | |
trials = purrr::map_dbl(1:100000, function(b) { | |
# Take 100 shots and record if basket is made | |
shots = as.numeric(runif(n) < p) | |
# Observe streaks | |
hot_hand_shot_results = c() | |
streak_count = 0 | |
for (i in 1:n) { | |
# if streak is at least k, then mark this shot | |
if (streak_count >= k) { | |
hot_hand_shot_results = c(hot_hand_shot_results, shots[i]) | |
} | |
# update count | |
streak_count = ifelse(shots[i] == 1, streak_count + 1, 0) | |
} | |
# Proportion of "hot-hand shots" made | |
if (length(hot_hand_shot_results) > 0) { | |
mean(hot_hand_shot_results) | |
} else { | |
NA | |
} | |
}) | |
# Filter out trials where the streak was never hit | |
trials = trials[!is.na(trials)] | |
avg_pct_hot_hand_shots_made = mean(trials) | |
} | |
# %% | |
simulations = expand_grid( | |
# probability of making a basket | |
p = c(0.25, 0.5, 0.75), | |
# number of shots recorded | |
n = 1:100, | |
# number of shots made in a row before testing for hot hand | |
k = 1:4, | |
) |> | |
# need n >= k + 1 shots to record anything | |
filter(n >= k + 1) |> | |
mutate(simulation_id = cur_group_id(), .by = c("p", "k")) |> | |
mutate(color_label = paste0("k = ", k)) | |
# Run simulation for each (n, p, k) | |
simulations = simulations |> | |
rowwise() |> | |
mutate( | |
avg_pct_hot_hand_shots_made = simulation(n, p, k) | |
) | |
# %% | |
(p = ggplot(simulations) + | |
geom_line( | |
aes( | |
x = n, y = avg_pct_hot_hand_shots_made, | |
group = simulation_id, color = color_label | |
), | |
size = 1.12 | |
) + | |
geom_hline(yintercept = c(0.25, 0.5, 0.75)) + | |
scale_y_continuous( | |
breaks = c(0.25, 0.5, 0.75), | |
labels = scales::label_percent(suffix = "\\%") | |
) + | |
scale_color_manual( | |
values = c("#d1d5db", "#9ca3af", "#6b7280", "#4b5563") | |
) + | |
labs( | |
x = "Number of shots recorded per trial", | |
y = "Average \\% of hot hand shots made", | |
color = NULL | |
) + | |
kfbmisc::theme_kyle(base_size = 13) + | |
theme( | |
legend.position = "bottom", | |
legend.key.spacing.x = unit(8, "mm") | |
)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
library(tidyverse)
Created on 2024-03-19 with reprex v2.1.0