I've been playing around with regista and trying to get the Dixon-Coles model to work using shot data on the Finnish Veikkausliiga, but getting stuck because of an issue with broom - as can be seen from the below reprex, it gives the error: "Error: No tidy method for objects of class dixoncoles" - this seems to be true for all broom functions, as I was using broom::augment when I first noticed the issue. I replicated the issue using exact code from your blog post (http://www.statsandsnakeoil.com/2018/06/22/dixon-coles-and-xg-together-at-last/) so I don't think it should be an issue on my end.
library(tidyverse)
games <-
read_csv("https://git.io/fNmRy") %>%
filter(season == 2017) %>%
nest(side, xg, .key = "shots")
#> Parsed with column specification:
#> cols(
#> match_id = col_double(),
#> date = col_datetime(format = ""),
#> home = col_character(),
#> away = col_character(),
#> hgoals = col_double(),
#> agoals = col_double(),
#> side = col_character(),
#> xg = col_double(),
#> league = col_character(),
#> season = col_double()
#> )
#> Warning: All elements of `...` must be named.
#> Did you want `shots = c(side, xg)`?
simulate_shots <- function(xgs) {
tibble::tibble(goals = 0:length(xgs),
prob = poisbinom::dpoisbinom(0:length(xgs), xgs))
}
simulate_game <- function(shot_xgs) {
home_xgs <- shot_xgs %>% dplyr::filter(side == "h") %>% pull(xg)
away_xgs <- shot_xgs %>% dplyr::filter(side == "a") %>% pull(xg)
home_probs <- simulate_shots(home_xgs) %>% dplyr::rename_all(function(x) paste0("h", x))
away_probs <- simulate_shots(away_xgs) %>% dplyr::rename_all(function(x) paste0("a", x))
tidyr::crossing(home_probs, away_probs) %>%
dplyr::mutate(prob = .data$hprob * .data$aprob)
}
simulated_games <-
games %>%
mutate(simulated_probabilities = map(shots, simulate_game)) %>%
select(match_id, home, away, simulated_probabilities) %>%
unnest(cols = c(simulated_probabilities)) %>%
filter(prob > 0.001) # Keep the number of rows vaguely reasonable
library(regista)
# Fit a "vanilla" Dixon-Coles model (on observed goals)
fit_vanilla <- dixoncoles(
hgoal = hgoals,
agoal = agoals,
hteam = home,
ateam = away,
data = factor_teams(games, c("home", "away"))
)
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
# Fit on the simulated data, weighted by probability
fit_simulated <- dixoncoles(
hgoal = hgoals,
agoal = agoals,
hteam = home,
ateam = away,
weights = prob,
data = factor_teams(simulated_games, c("home", "away")))
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
#> Warning in model.matrix.default(~values - 1, model.frame(~values - 1), contrasts
#> = FALSE): non-list contrasts argument ignored
estimates <-
inner_join(
broom::tidy(fit_vanilla),
broom::tidy(fit_simulated),
by = c("parameter", "team"),
suffix = c("_vanilla", "_xg")
) %>%
mutate(value_vanilla = exp(value_vanilla),
value_xg = exp(value_xg))
#> Error: No tidy method for objects of class dixoncoles