Evaluation of a split season team ability model

t-distribution degrees of freedom

Following the EPL model, I’ve included a parameter for the degrees of freedom used for the t-distribution. Most of the estimated values are larger than 7, which is the fixed value I used for in the previous model.

samps <- rstan::extract(fit)

quantile(samps$nu, probs = c(0.025, 0.5, 0.975))
#>      2.5%       50%     97.5% 
#>  7.609503 10.963311 18.136507

data.frame(nu = samps$nu) %>%
    ggplot(aes(nu)) +
    geom_histogram(bins = 40) +
    labs(x = expression(nu)) +
    theme_remove_axis("y")

With a median \(\nu\) near 11, it probably makes sense to stick with a t-distribution rather than switching to a normal.

set.seed(113724)
nvals <- tibble(x = seq(-6, 6, length.out = 500),
                y = dnorm(x))
tvals <- expand.grid(x = nvals$x, df = c(3, 7, 11, 17)) %>%
    mutate(y = dt(x, df = df),
           df = factor(df))

ggplot(tvals) +
    geom_line(aes(x = x, y = y, color = df)) +
    geom_line(data = mutate(nvals, distr = "normal"),
              aes(x = x, y = y, linetype = distr)) +
    labs(color = expression(nu)) +
    guides(color = guide_legend(order = 0),
           linetype = guide_legend(order = 1, title = NULL)) +
    theme_void() +
    theme(legend.position = c(0.2, 0.5)) +
    scale_linetype_manual(values = c("dashed")) +
    scale_color_manual(values = c(tc$primary, tc$secondary,
                                  tc$primary_light, tc$secondary_light))

Both \(\nu\) and \(\sigma_y\) influence the range of observed score differentials, and, unsurprisingly, iterations with larger values for \(\nu\) tend to have larger values for \(\sigma_y\).

data.frame(nu = samps$nu,
           sigma_y = samps$sigma_y) %>%
    ggplot(aes(nu, sigma_y)) +
    labs(x = expression(nu),
         y = expression(sigma[y])) +
    geom_point(alpha = 0.2, shape = 16)

Home-field advantage

The model includes a term for home-field avantage. The estimates are uncertain, small in magnitude, and slightly shifted in the direction of the home team. No suprises there.

quantile(samps$b_home, probs = c(0.025, 0.5, 0.975))
#>       2.5%        50%      97.5% 
#> -0.1235046  0.0405651  0.2009177

data.frame(b_home = samps$b_home) %>%
    ggplot(aes(b_home)) +
    geom_vline(xintercept = 0, size = 0.8, color = tc$primary_lighter) +
    geom_histogram(bins = 40, size = 0.3) +
    expand_limits(x = c(-0.3, 0.3)) +
    labs(x = expression(beta[home])) +
    theme_remove_axis("y")

Perhaps this parameter should be estimated for each team in order to catch park-specific effects. That’s a bit complicated because a hitter’s park can help both teams score more runs, but I suppose it could capture the extent that the home team plays to (or fails to play to) their park’s strengths.

Abilities

The main difference between this model and its predecessor is that a single-season ability estimate for a team is split into eight periods. First, let’s see if the general pattern for the abilities looks right. A team’s abilities across periods share a common mean, so two ability parameters for the same team should be correlated across iterations, while parameters for different teams shouldn’t show the same coupling. Below are the pairs plots for the seventh and eighth periods for the 29th team and the first and second periods for the 30th team.

samps_flat <- as.array(fit)

prev_theme <- theme_update(panel.grid = element_blank(),
                           axis.text.y = element_blank(),
                           axis.text.x = element_blank())
color_scheme_set("gray")
mcmc_pairs(samps_flat,
           pars = c("a[7,29]", "a[8,29]", "a[1,30]", "a[2,30]"),
           off_diag_fun = "hex")
theme_set(prev_theme)

And here are the ability estimates for each team and period.

source("../code/lib/utils.R")
info <- read_rdump("../outputs/models/rundiff-split_2011.info.R")

avals <- trace_intervals(samps$a, c("period", "team_idx")) %>%
    mutate(team = info$team_names[team_idx])

teams_ranked <- arrange(info$wins_2011, desc(n_wins))$team

mutate(avals, team = factor(team, levels = teams_ranked)) %>%
    ggplot(aes(x = period, y = mean)) +
    geom_hline(yintercept = 0, color = tc$primary_lighter) +
    geom_linerange(aes(ymin = p10, ymax = p90), size = 0.3) +
    geom_point() +
    facet_wrap(~ team) +
    labs(y = "mean ability (with 80% intervals)",
         title = "Team ability estimates for 2011 season",
         subtitle = "sorted by regular season standings")

It seems like the periods are capturing some variation, though many teams might be sufficiently summarized by a single period ability estimate.

There are some interesting teams, such as the Brewers, that look out of place based on their season standings. I’m not sure what’s going on here. Assuming it’s not a coding error, I suppose it should come down to some combination of the observed match-ups (e.g., weaker division) and iter-team variation in run differentials (e.g., winning a disproportionate number of close games).