dixoncoles-benchmarks.R

benchmark <-
  games %>%
  mutate(
    outcome = case_when(
      hgoals > agoals  ~ "home_win",
      agoals > hgoals  ~ "away_win",
      hgoals == agoals ~ "draw"
    )
  ) %>%
  count(outcome) %>%
  mutate(prob = n / sum(n)) %>%
  crossing(games) %>%
  mutate(
    obs_outcome = case_when(
      hgoals > agoals  ~ "home_win",
      agoals > hgoals  ~ "away_win",
      hgoals == agoals ~ "draw"
    )
  ) %>%
  mutate(log_loss = ifelse(outcome == obs_outcome, -log(prob), -log(1 - prob))) %>%
  summarise(log_loss = mean(log_loss)) %>%
  mutate(model = "Benchmark")

market <-
  14:17 %>%
  map_chr(~ str_c(.x, .x + 1)) %>%
  map_chr(~ str_glue("http://www.football-data.co.uk/mmz4281/{.x}/E0.csv")) %>%
  map_dfr(read_csv) %>%
  mutate(H = 1 / PSCH,
         D = 1 / PSCD,
         A = 1 / PSCA,
         vig = H + D + A,
         H = H / vig,
         D = D / vig,
         A = A / vig) %>%
  select(FTR, H, D, A) %>%
  gather(key, p, -FTR) %>%
  mutate(log_loss = ifelse(key == FTR, -log(p), -log(1 - p))) %>%
  summarise(log_loss = mean(log_loss, na.rm = T)) %>%
  mutate(model = "Closing odds")

marketratings <-
  read_csv("data/marketratings_predictions.csv") %>%
  filter(season >= 2014,
         country == "England",
         competition == "Premier League") %>%
  select(obs_outcome = result,
         H = home_win_model,
         D = draw_model,
         A = away_win_model) %>%
  gather(outcome, prob, H, D, A, -obs_outcome) %>%
  mutate(log_loss = ifelse(outcome == obs_outcome, -log(prob), -log(1 - prob))) %>%
  summarise(log_loss = mean(log_loss)) %>%
  mutate(model = "Market-ratings")