/
westbrook.R
69 lines (56 loc) · 2.46 KB
/
westbrook.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
library(tidyverse)
library(ggplot2)
library(rstan)
library(shinystan)
setwd("~/basketball")
df = read_csv('data/rw_nba.csv')# %>% sample_n(1000)
sdata = list(N = nrow(df),
M = 10,
scale = 0.2,
x = df$x,
y = df$result)
fit = stan('models/approx_bernoulli_gp.stan', data = sdata, chains = 4, cores = 4, iter = 2000)
extract(fit, c("l", "log10error")) %>% as_tibble %>% gather(param, value, c("l", "log10error")) %>%
ggplot(aes(value)) +
geom_histogram() +
facet_grid(. ~ param, scales = "free_x")
sdata = list(N = nrow(df),
x = df$period,
y = df$result)
fit_grouped = stan('models/bernoulli_grouped.stan', data = sdata, chains = 4, cores = 4, iter = 2000)
a = as_tibble(extract(fit, "f")$f)
colnames(a) = 1:ncol(a)
b = as_tibble(list(idx = 1:nrow(df), time = df$elapsed))
out = inner_join(a %>% gather(idx, f) %>% mutate(idx = as.integer(idx)), b, by = "idx")
summary = out %>% group_by(time) %>%
summarize(mean = mean(f),
q1 = quantile(f, 0.025),
q2 = quantile(f, 0.167),
q3 = quantile(f, 0.833),
q4 = quantile(f, 0.975)) %>%
ungroup()
a = as_tibble(extract(fit_grouped, "f")$f)
colnames(a) = 1:ncol(a)
b = as_tibble(list(period = 1:4, time = ((1:4) - 1) * 12 + 6))
out_grouped = inner_join(a %>% gather(period, f) %>% mutate(period = as.integer(period)), b, by = "period")
summary_grouped = out_grouped %>% group_by(time) %>%
summarize(mean = mean(f),
m = quantile(f, 0.025),
p = quantile(f, 0.975)) %>%
ungroup()
summary %>% ggplot(aes(time, mean)) +
geom_ribbon(aes(ymin = q1, ymax = q2), alpha = 0.75, fill = "dodgerblue2") +
geom_ribbon(aes(ymin = q2, ymax = q3), alpha = 0.75, fill = "orangered1") +
geom_ribbon(aes(ymin = q3, ymax = q4), alpha = 0.75, fill = "dodgerblue2") +
geom_line() +
geom_line(aes(time, q1), alpha = 1.0, size = 0.125) +
geom_line(aes(time, q2), alpha = 1.0, size = 0.125) +
geom_line(aes(time, q3), alpha = 1.0, size = 0.125) +
geom_line(aes(time, q4), alpha = 1.0, size = 0.125) +
#geom_point(data = out2, aes(time, f), size = 0.1, alpha = 0.01) +
#geom_boxplot(data = summary2, aes(time, f, group = time)) +
geom_errorbar(data = summary_grouped, aes(time, ymin = m, ymax = p), width = 2.0) +
geom_point(data = summary_grouped, aes(time, mean)) +
xlab("Game time") +
ylab("Shooting percentage") +
ggtitle("Russell Westbrook's shooting percentage (w/ est. 95% conf. intervals)")