Marathonbet’s accuracy in predicting sumo results

 

The only packages we’ll need are ROCR (to measure prediction accuracy) and tidyverse (for everything else — tidyverse.org):

library(ROCR)
library(tidyverse)

 

Marathonbet started offering bets on Makuuchi bouts. I’ve collected the odds for January and March tournaments from betmarathon.com/en/betting/Sumo/ (available only during Honbasho):

odds <- read_csv("odds.csv", col_types = "cicdcd")
odds %>% arrange(basho, day)

 

I’d missed the first day of the January tournament, and asked the customer service if there was an archive with historical odds. No:

Please be aware that this option is not available.
Due to the odds are movement depents of the fluctuations of the market.

Anyway, 541 bouts should be enough for our purposes:

odds %>% count(basho, day)

 

Results for all divisions are easily fetched from Sumo Reference (day 16 stands for play-offs):

results <- read_csv("results.csv", col_types = "cicicic")
results %>% count(basho, day)

 

To join odds with results:

1. As they don’t necessarily order wrestlers (rikishi1, rikishi2) in the same way, join odds with a mirrored copy of itself.
2. Calculate implied probability of the first wrestler winning.
3. Filter out forfeits (see fusen).

odds_and_results <- merge(
    rbind(
        odds,
        odds %>% rename(
            rikishi1 = rikishi2, odds1 = odds2,
            rikishi2 = rikishi1, odds2 = odds1
        )
    ) %>% mutate(win1_prob = odds2 / (odds1 + odds2)),
    results %>% filter(kimarite != "fusen")
)
odds_and_results

 

Sanity check — what’s the distribution of implied probability to win for winner and losers?

ggplot(odds_and_results, aes(factor(win1, labels = c("lost", "won")), win1_prob)) + 
    geom_boxplot(outlier.size = .5) + 
    geom_jitter(size = .5, width = .1) + 
    labs(x = "", y = "implied win probability")

 

To measure prediction accuracy, we’ll use ROC curve:

pred <- prediction(
    predictions = odds_and_results$win1_prob,
    labels = odds_and_results$win1
)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
ggplot(data.frame(x = perf@x.values[[1]], y = perf@y.values[[1]]), aes(x, y)) + 
    geom_line() + 
    labs(
        title = sprintf("%.1f%%", unlist(performance(pred, "auc")@y.values) * 100),
        subtitle = "area under ROC curve",
        x = "false positive rate",
        y = "false negative rate"
    ) + 
    geom_abline(intercept = 0, slope = 1, linetype = "dotted")