- PVSM.RU - https://www.pvsm.ru -
На протяжении многих лет я слежу за снукером, как за спортом. В нем есть всё: гипнотизирующая красота интеллектуальной игры, элегантность ударов киём и психологическая напряжённость соревнования. Но есть одна вещь, которая мне не нравится — его рейтинговая система.
Её основной недостаток заключается в том, что она учитывает только факт турнирного достижения без учёта "сложности" матчей. Такого недостатка лишена модель Эло [1], которая следит за "силой" игроков и обновляет её в зависимости от результатов матчей и "силы" соперника. Однако, и она подходит не идеально: считается, что все матчи проходят в равных условиях, а в снукере они играются до определённого количества выигранных фреймов (партий). Для учёта этого факта, я рассмотрел другую модель, которую назвал ЭлоБета.
В данной статье изучается качество моделей Эло и ЭлоБета на результатах снукерных матчей. Важно отметить, что основными целями являются оценка "силы" игроков и создание "справедливого" рейтинга, а не построение прогностических моделей для получения выгоды.
Текущий снукерный рейтинг основан на достижениях игрока в турнирах с их разной "весомостью". Давным давно учитывались только Чемпионаты Мира. После появления множества других соревнований была разработана таблица очков, которые игрок мог заработать, дойдя до определённой стадии турнира. Сейчас рейтинг имеет вид "скользящей" суммы призовых денег, которые игрок заработал в течение (приблизительно) крайних двух календарных лет.
У этой системы есть два главных преимущества: она простая (выигрывай много денег — поднимайся в рейтинге) и прогнозируемая (хочешь подняться на определённое место — выиграй определённое количество денег, при прочих равных). Проблема состоит в том, что при таком способе не учитывается сила (навык, форма) соперников. Обычным контр-аргументом является: "Если игрок достиг поздней стадии турнира, тогда он/она по определению является сильным игроком на текущий момент" ("слабые игроки не выигрывают турниры"). Звучит достаточно убедительно. Однако в снукере, как и в любом спорте, должна учитываться роль случая: если игрок "слабее", то это не означает, что он/она никогда не может выиграть в матче против игрока "сильнее". Просто это случается реже, чем обратный сценарий. Именно здесь выходит на сцену модель Эло.
Идея модели Эло заключается в том, что каждый игрок ассоциируется с числовым рейтингом. Вводится предположение о том, что результат игры между двумя игроками может быть предсказан, основываясь на разнице их рейтингов: большие значения означают большую вероятность победы "сильного" (с более высоким рейтингом) игрока. Рейтинг Эло основан на текущей "силе", вычисленной на основании результатов матчей с другими игроками. Это избегает основного недостатка текущей официальной рейтинговой системы. Такой подход также позволяет обновлять рейтинг игрока в течение турнира, чтобы численно реагировать на его хорошее выступление.
Имея практический опыт с рейтингом Эло, мне кажется, что он должен хорошо показать себя в снукере. Однако, есть одно препятствие: он создан для соревнований с единым типом матча. Конечно, существуют вариации для учёта преимуществ домашнего поля [3] в футболе и первого хода [4] в шахматах (обе в виде добавления фиксированного количества рейтинговых очков игроку с преимуществом). В снукере же матчи играются в формате "best of N": побеждает игрок, который первый выиграет фреймов (партий). Мы также будем называть этот формат "до побед".
Интуитивно, победа в матче до 10 побед (финал серьёзного турнира) должна даваться сложнее "слабому" игроку, чем победа в матче до 4 побед (первый раунд текущих турниров Home Nations). Это учитывается в предложенной мной модели ЭлоБета.
Идея использования рейтинга Эло в снукере отнюдь не нова. Например, есть следующие работы:
Данная статья предназначена для пользователей языка R [10], заинтересованных в изучении рейтинга Эло, и для любителей снукера. Все эксперименты написаны с идеей быть воспроизводимыми. Код спрятан под спойлерами, имеет комментарии и использует пакеты tidyverse [11], так что может быть сам по себе интересен для чтения пользователям R. Предполагается последовательное выполнение всего представленного кода. Одним файлом его можно найти здесь [12].
Статья организована следующим образом:
Нам понадобится следующая инициализация.
# Пакеты для манипуляций с данными
suppressPackageStartupMessages(library(dplyr))
library(tidyr)
library(purrr)
# Пакет для визуализации
library(ggplot2)
# Пакет для рейтингов
suppressPackageStartupMessages(library(comperank))
theme_set(theme_bw())
# Не должно понадобиться. Просто на всякий случай.
set.seed(20180703)
Обе модели основаны на следующих предположениях:
#' @details Данная функция векторизована по всем своим аргументам. Использование
#' `...` критично для возможности передачи других аргументов в будущем.
#'
#' @return Вероятность того, что игрок 1 (с рейтингом `rating1`) выиграет матч
#' против игрока 2 (рейтинг `rating2`). Разница рейтингов напрямую влияет на
#' результат.
elo_win_prob <- function(rating1, rating2, ksi = 400, ...) {
norm_rating_diff <- (rating2 - rating1) / ksi
1 / (1 + 10^norm_rating_diff)
}
#' @return Рейтинговая функция для модели Эло, которую можно передать в
#' `comperank::add_iterative_ratings()`.
elo_fun_gen <- function(K, ksi = 400) {
function(rating1, score1, rating2, score2) {
comperank::elo(rating1, score1, rating2, score2, K = K, ksi = ksi)[1, ]
}
}
Модель Эло обновляет рейтинги по следующей процедуре:
Вычисление вероятности победы определённого игрока в матче (до его начала). Вероятность победы одного игрока (будем называть его/её "первым") с идентификатором и рейтингом над другим игроком ("вторым") с идентификатором и рейтингом равняется
При таком подходе вычисление вероятности подчиняется третьему предположению.
Нормировка разности на 400 — это математический способ сказать, какая разность считается "большой". Это число может быть заменено на параметр модели , однако это влияет только на разброс будущих рейтингов и обычно является излишним. Значение 400 достаточно стандартно.
При общем подходе вероятность победы равняется , где некоторая строго возрастающая функция со значениями от 0 до 1. Мы будем использовать логистическую кривую. Более полное исследование можно найти в этой статье [13].
Вычисление результата матча . В базовой модели он равняется 1 в случае победы первого игрока (поражения второго), 0.5 в случае ничьи и 0 в случае поражения первого игрока (победы второго).
Обновление рейтингов:
Замечания:
Почему такой алгоритм имеет смысл? В случае равенства рейтингов всегда равняется . Допустим, например, что и . Это означает, что вероятность победы первого игрока равна , т.е. он/она выиграет 1 матч из 11.
Это показывает, что модель Эло подчиняется пятому предположению: победа над соперником "сильнее" сопровождается большим приростом рейтинга, чем победа над соперником "слабее", и наоборот.
Конечно, у модели Эло есть свои (достаточно высокоуровневые) практические особенности [14]. Однако, наиболее важной для нашего исследования является следующая: предполагается, что все матчи проводятся в равных условиях. Это означает, что не учитывается дистанция матча: победа в матче до 4 побед вознаграждается так же, как победа в матче до 10 побед. Здесь выходит на сцену модель ЭлоБета.
#' @details Данная функция векторизована по всем своим аргументам.
#'
#' @return Вероятность того, что игрок 1 (с рейтингом `rating1`) выиграет матч
#' против игрока 2 (рейтинг `rating2`). Матч играется до `frames_to_win`
#' победных фреймов. Разница рейтингов напрямую влияет на вероятность победы
#' в одном фрейме.
elobeta_win_prob <- function(rating1, rating2, frames_to_win, ksi = 400, ...) {
prob_frame <- elo_win_prob(rating1 = rating1, rating2 = rating2, ksi = ksi)
# Вероятность того, что первый игрок выиграет `frames_to_win` фреймов раньше
# второго опираясь на вероятность первого игрока выиграть один фрейм
# (`prob_frame`). Фреймы считаются независимыми.
pbeta(prob_frame, frames_to_win, frames_to_win)
}
#' @return Результат матча в терминах победы первого игрока: 1 если он/она
#' выиграл(а), 0.5 в случае ничьи и 0 если он/она проиграл(а).
get_match_result <- function(score1, score2) {
# В снукере ничьи (обычно) не бывает, но это учитывает общий случай.
near_score <- dplyr::near(score1, score2)
dplyr::if_else(near_score, 0.5, as.numeric(score1 > score2))
}
#' @return Рейтинговая функция для модели ЭлоБета, которую можно передать в
#' `add_iterative_ratings()`.
elobeta_fun_gen <- function(K, ksi = 400) {
function(rating1, score1, rating2, score2) {
prob_win <- elobeta_win_prob(
rating1 = rating1, rating2 = rating2,
frames_to_win = pmax(score1, score2), ksi = ksi
)
match_result <- get_match_result(score1, score2)
delta <- K * (match_result - prob_win)
c(rating1 + delta, rating2 - delta)
}
}
В модели Эло разница рейтингов напрямую влияет на вероятность победы во всём матче. Главной идеей модели ЭлоБета является прямое влияние разницы рейтингов на вероятность победы в одном фрейме и явное вычисление вероятности игрока выиграть фреймов раньше соперника.
Остаётся вопрос: как вычислить такую вероятность? Оказывается, это одна из старейших задач в истории теории вероятностей и имеет своё название — задача о разделении ставок [15] (Problem of points). Очень приятное изложение можно найти в этой статье [16]. Используя её обозначения, искомая вероятность равняется:
Здесь — вероятность первого игрока выиграть матч до побед; — вероятность его/её победы в одном фрейме (у соперника вероятность ). При таком подходе предполагается, что результаты фрейма внутри матча не зависят друг от друга. Это может подвергаться сомнению, но является необходимым предположением для данной модели.
Существует ли более быстрый способ вычисления? Оказывается, ответ положительный. После нескольких часов преобразования формул, практических экспериментов и поисков в интернете я нашёл следующее свойство [17] у регуляризованной неполной бета-функции [18] . Подставив в это свойство и заменив на получается .
Также это является хорошей новостью для пользователей R, т.к. может быть вычислено как pbeta(p, n, n)
. Замечание: общий случай вероятности победы в фреймах раньше, чем соперник выиграет , также может быть вычислено как и pbeta(p, n, m)
соответственно. Это раскрывает богатые возможности по обновлению вероятности победы в течение матча.
Процедура обновления рейтингов в рамках модели ЭлоБета имеет следующий вид (при известных рейтингах и , необходимом для победы количестве фреймов и результате матча , как в модели Эло):
Замечание: т.к. разность рейтингов напрямую влияет на вероятность победы в одном фрейме, а не во всём матче, следует ожидать меньшее оптимальное значение коэффициента : часть значения исходит от усиливающего эффекта .
Идея вычисления результата матча на основании вероятности победы в одном фрейме не очень нова. На этом сайте [19] авторства François Labelle можно найти онлайн вычисление вероятности победы в "best of " матче, наряду с другими функциями. Я был рад увидеть, что наши результаты вычислений совпадают. Однако, не смог найти никаких источников по введению такого подхода в процедуру обновления рейтингов Эло. Как и раньше, буду очень признателен за любую информацию по данной теме.
Я только смог найти эти статью [20] и описание [21] системы Эло на игровом сервере по нардам (FIBS). Есть также русскоязычный аналог [22]. Здесь разная длительность матчей учитываются путём умножения разницы рейтингов на квадратный корень из дистанции матча. Однако, не похоже, чтобы это имело какого-то теоретического обоснования.
У эксперимента есть несколько целей. На основании данных о результатах снукерных матчей:
# Функция для разделения наблюдений по типам "train", "validation" и "test"
split_cases <- function(n, props = c(0.5, 0.25, 0.25)) {
breaks <- n * cumsum(head(props, -1)) / sum(props)
id_vec <- findInterval(seq_len(n), breaks, left.open = TRUE) + 1
c("train", "validation", "test")[id_vec]
}
pro_players <- snooker_players %>% filter(status == "pro")
# Матчи только между профессионалами
pro_matches_all <- snooker_matches %>%
# Используем только реально состоявшиеся матчи
filter(!walkover1, !walkover2) %>%
# Оставляем только матчи между профессионалами
semi_join(y = pro_players, by = c(player1Id = "id")) %>%
semi_join(y = pro_players, by = c(player2Id = "id")) %>%
# Добавляем столбец 'season'
left_join(
y = snooker_events %>% select(id, season), by = c(eventId = "id")
) %>%
# Обеспечиваем упорядоченность по времени окончания матча
arrange(endDate) %>%
# Подготавливаем к формату widecr
transmute(
game = seq_len(n()),
player1 = player1Id, score1, player2 = player2Id, score2,
matchId = id, endDate, eventId, season,
# Вычисляем тип матча ("train", "validation" или "test") в пропорции
# 50/25/25
matchType = split_cases(n())
) %>%
# Конвертируем в формат widecr
as_widecr()
# Матчи только между профессионалами в непригласительных турнирах (убираются, в
# основном, турниры Championship League).
pro_matches_off <- pro_matches_all %>%
anti_join(
y = snooker_events %>% filter(type == "Invitational"),
by = c(eventId = "id")
)
# Функция для подтверждение разбиения
get_split <- . %>% count(matchType) %>% mutate(share = n / sum(n))
# Это должно давать разбиение 50/25/25 (train/validation/test)
pro_matches_all %>% get_split()
## # A tibble: 3 x 3
## matchType n share
## <chr> <int> <dbl>
## 1 test 1030 0.250
## 2 train 2059 0.5
## 3 validation 1029 0.250
# Это даёт другое разбиение, потому что пригласительные турниры не распределены
# равномерно в течение сезона. Однако, при таком подходе матчи разбиты на
# основании тех же разделителей __по времени__, что и в `pro_matches_all`. Это
# гарантирует, что матчи с одним типом представляют одинаковые __периоды во
# времени__.
pro_matches_off %>% get_split()
## # A tibble: 3 x 3
## matchType n share
## <chr> <int> <dbl>
## 1 test 820 0.225
## 2 train 1810 0.497
## 3 validation 1014 0.278
# Сетка для коэффициента K
k_grid <- 1:100
Мы будем использовать данные о снукере из пакета comperank [23]. Оригинальным источником является сайт snooker.org [24]. Результаты взяты из следующих матчей:
Конечное количество используемых матчей равно 4118 для "всех матчей" и 3644 для "официальных матчей" (62.9 и 55.6 на одного игрока соответственно).
#' @param matches Объект класса `longcr` или `widecr` со столбцом `matchType`
#' (тип матча для эксперимента: "train", "validation" или "test").
#' @param test_type Тип матчей для вычисления качества модели. Для корректности
#' эксперимента все матчи этого типа должны были проводиться позже всех других
#' ("разогревочных") матчей. Это означает, что у них должны быть бОльшие
#' значения столбца `game`.
#' @param k_vec Вектор коэффициентов K для вычисления качества модели.
#' @param rate_fun_gen Функция, которая при передаче коэффициента K возвращает
#' рейтинговую функцию для передачи в `add_iterative_ratings()`.
#' @param get_win_prob Функция для вычисления вероятности победы на основании
#' рейтингов игроков (`rating1`, `rating2`) и количества фреймов, необходимого
#' для победы в матче (`frames_to_win`). __Замечание__: она должна быть
#' векторизована по всем своим аргументам.
#' @param initial_ratings Начальные рейтинги в формате для
#' `add_iterative_ratings()`.
#'
#' @details Данная функция вычисляет:
#' - Историю итеративных рейтингов после упорядочивания `matches` по возрастанию
#' столбца `game`.
#' - Для матчей с типом `test_type`:
#' - Вероятность победы игрока 1.
#' - Результат матча в терминах победы первого игрока: 1 если он/она
#' выиграл(а), 0.5 в случае ничьи и 0 если он/она проиграл(а).
#' - Качество в виде RMSE: квадратный корень из средней квадратичной ошибки, где
#' "ошибка" - разность между прогнозной вероятностью и результатом матча.
#'
#' @return Tibble со столбцами 'k' для коэффициента K и 'goodness' для
#' величины качества RMSE.
compute_goodness <- function(matches, test_type, k_vec, rate_fun_gen,
get_win_prob, initial_ratings = 0) {
cat("n")
map_dfr(k_vec, function(cur_k) {
# Отслеживание хода выполнения
cat(cur_k, " ")
matches %>%
arrange(game) %>%
add_iterative_ratings(
rate_fun = rate_fun_gen(cur_k), initial_ratings = initial_ratings
) %>%
left_join(y = matches %>% select(game, matchType), by = "game") %>%
filter(matchType %in% test_type) %>%
mutate(
# Количество фреймов для победы в матче
framesToWin = pmax(score1, score2),
# Вероятность победы игрока 1 в матче до `framesToWin` побед
winProb = get_win_prob(
rating1 = rating1Before, rating2 = rating2Before,
frames_to_win = framesToWin
),
result = get_match_result(score1, score2),
squareError = (result - winProb)^2
) %>%
summarise(goodness = sqrt(mean(squareError)))
}) %>%
mutate(k = k_vec) %>%
select(k, goodness)
}
#' Обёртка для `compute_goodness()` для использования с матрицей эксперимента
compute_goodness_wrap <- function(matches_name, test_type, k_vec,
rate_fun_gen_name, win_prob_fun_name,
initial_ratings = 0) {
matches_tbl <- get(matches_name)
rate_fun_gen <- get(rate_fun_gen_name)
get_win_prob <- get(win_prob_fun_name)
compute_goodness(
matches_tbl, test_type, k_vec, rate_fun_gen, get_win_prob, initial_ratings
)
}
#' Функция для осуществления эксперимента
#'
#' @param test_type Вектор значений `test_type` (тип теста) для
#' `compute_goodness()`.
#' @param rating_type Имена рейтинговых моделей (типы рейтинга).
#' @param data_type Суффиксы типов данных.
#' @param k_vec,initial_ratings Величины для `compute_goodness()`.
#'
#' @details Данная функция генерирует матрицу эксперимента и вычисляет несколько
#' значений качества моделей для разных комбинаций типов рейтинга и данных. Для
#' того, чтобы она работала, в глобальном окружении необходимо наличие
#' переменных по следующими комбинациями имён:
#' - "pro_matches_" + `<типы теста>` + `<типы данных>` для результатов матчей.
#' - `<типы рейтинга>` + "_fun_gen" для генераторов рейтинговых функций.
#' - `<типы рейтинга>` + "_win_prob" для функций, вычисляющий вероятность
#' победы.
#'
#' @return Tibble со следующими столбцами:
#' - __testType__ <chr> : Идентификатор типа теста.
#' - __ratingType__ <chr> : Идентификатор типа рейтинга.
#' - __dataType__ <chr> : Идентификатор типа данных.
#' - __k__ <dbl/int> : Значение коэффициента K.
#' - __goodness__ <dbl> : Значение качества модели.
do_experiment <- function(test_type = c("validation", "test"),
rating_type = c("elo", "elobeta"),
data_type = c("all", "off"),
k_vec = k_grid,
initial_ratings = 0) {
crossing(
testType = test_type, ratingType = rating_type, dataType = data_type
) %>%
mutate(
dataName = paste0("pro_matches_", testType, "_", dataType),
kVec = rep(list(k_vec), n()),
rateFunGenName = paste0(ratingType, "_fun_gen"),
winProbFunName = paste0(ratingType, "_win_prob"),
initialRatings = rep(list(initial_ratings), n()),
experimentData = pmap(
list(dataName, testType, kVec,
rateFunGenName, winProbFunName, initialRatings),
compute_goodness_wrap
)
) %>%
unnest(experimentData) %>%
select(testType, ratingType, dataType, k, goodness)
}
Для нахождения "оптимального" значения будем использовать равномерную решётку . Учёт больших значений кажется не обоснованным, что подтверждается экспериментом. Используется следующая процедура:
add_iterative_ratings()
из пакета comperank
. Такой подход описывает "онлайн рейтинги", т.е. обновление после каждого матча.Так как одной из целей является изучение стабильности моделей, данные будут разбиты на три подмножества: "train" (обучающее), "validation" (валидационное) и "test" (тестовое). Они отсортированы по времени, т.е. любой матч из "train"/"validation" имеет время окончания раньше, чем любой матч из "validation"/"test". Я решил разбить данные в пропорции 50/25/25 для "всех матчей". Разбиение "официальных матчей" делается путём удаления из "всех матчей" пригласительных турниров. Это даёт не совсем желаемую пропорцию: 49.7/27.8/22.5. Однако, такой подход обеспечивает, что матчи одного типа представляют одинаковые периоды во времени.
Эксперимент будет проведён для всех комбинаций следующих переменных:
pro_matches_validation_all <- pro_matches_all %>% filter(matchType != "test")
pro_matches_validation_off <- pro_matches_off %>% filter(matchType != "test")
pro_matches_test_all <- pro_matches_all
pro_matches_test_off <- pro_matches_off
# Выполнение занимает существенное время
experiment_tbl <- do_experiment()
plot_data <- experiment_tbl %>%
unite(group, ratingType, dataType) %>%
mutate(
testType = recode(
testType, validation = "Валидационный", test = "Тестовый"
),
groupName = recode(
group, elo_all = "Эло, все матчи", elo_off = "Эло, офиц. матчи",
elobeta_all = "ЭлоБета, все матчи",
elobeta_off = "ЭлоБета, офиц. матчи"
),
# Фиксация предпочтительного порядка
groupName = factor(groupName, levels = unique(groupName))
)
compute_optimal_k <- . %>% group_by(testType, groupName) %>%
slice(which.min(goodness)) %>%
ungroup()
compute_k_labels <- . %>% compute_optimal_k() %>%
mutate(label = paste0("K = ", k)) %>%
group_by(groupName) %>%
# Если оптимальное K в рамках одной панели находится справа от своей пары,
# её метке необходимо небольшое смещение вправо. Если слева - полное и
# небольшое смещение влево.
mutate(hjust = - (k == max(k)) * 1.1 + 1.05) %>%
ungroup()
plot_experiment_results <- function(results_tbl) {
ggplot(results_tbl) +
geom_hline(
yintercept = 0.5, colour = "#AA5555", size = 0.5, linetype = "dotted"
) +
geom_line(aes(k, goodness, colour = testType)) +
geom_vline(
data = compute_optimal_k,
mapping = aes(xintercept = k, colour = testType),
linetype = "dashed", show.legend = FALSE
) +
geom_text(
data = compute_k_labels,
mapping = aes(k, Inf, label = label, hjust = hjust),
vjust = 1.2
) +
facet_wrap(~ groupName) +
scale_colour_manual(
values = c(`Валидационный` = "#377EB8", `Тестовый` = "#FF7F00"),
guide = guide_legend(title = "Эксперимент", override.aes = list(size = 4))
) +
labs(
x = "Коэффициент K", y = "Качество модели (RMSE)",
title = "Лучшие значения качества моделей Эло и ЭлоБета почти равны",
subtitle = paste0(
'Использование официальных матчей (без пригласительных турниров) даёт ',
'более устойчивые результаты.n',
'Оптимальные значения K из тестового эксперимента (с более длительным ',
'"разогревом") меньше, чем из валидационного.'
)
) +
theme(title = element_text(size = 13), strip.text = element_text(size = 12))
}
plot_experiment_results(plot_data)
Кликабельно [27]
По результатам эксперимента можно сделать следующие выводы:
Группа | Оптимальное K | RMSE |
---|---|---|
Эло, все матчи | 24 | 0.465 |
Эло, офиц. матчи | 29 | 0.455 |
ЭлоБета, все матчи | 10 | 0.462 |
ЭлоБета, офиц. матчи | 11 | 0.453 |
Т.к. качество не сильно отличается, можно округлить оптимальные из "официальных матчей" (они демонстрируют большую устойчивость) до 5: для модели Эло это 30, для ЭлоБета — 10.
На основании этих результатов я склонен заключить, что модели Эло с и ЭлоБета с могут найти полезное применение в анализе официальных снукерных матчей. Однако, модель ЭлоБета учитывает различный формат матчей до побед, поэтому из двух следует предпочесть её.
Следующие результаты были вычислены используя "официальные матчи" с моделью ЭлоБета (). Все возможные выводы не следует рассматривать как личные по отношению какому-либо игроку.
# Вспомогательная функция
gather_to_longcr <- function(tbl) {
bind_rows(
tbl %>% select(-matches("2")) %>% rename_all(funs(gsub("1", "", .))),
tbl %>% select(-matches("1")) %>% rename_all(funs(gsub("2", "", .)))
) %>%
arrange(game)
}
# Извлечение лучшего значения коэффициента K
best_k <- experiment_tbl %>%
filter(testType == "test", ratingType == "elobeta", dataType == "off") %>%
slice(which.min(goodness)) %>%
pull(k)
#!!! Округляет к "красивому" числу, т.к. это не сильно влияет на качество !!!
best_k <- round(best_k / 5) * 5
# Вычисление рейтингов на момент окончания данных
elobeta_ratings <- rate_iterative(
pro_matches_test_off, elobeta_fun_gen(best_k), initial_ratings = 0
) %>%
rename(ratingEloBeta = rating_iterative) %>%
arrange(desc(ratingEloBeta)) %>%
left_join(
y = snooker_players %>% select(id, playerName = name), by = c(player = "id")
) %>%
mutate(rankEloBeta = order(ratingEloBeta, decreasing = TRUE)) %>%
select(player, playerName, ratingEloBeta, rankEloBeta)
elobeta_top16 <- elobeta_ratings %>%
filter(rankEloBeta <= 16) %>%
mutate(
rankChr = formatC(rankEloBeta, width = 2, format = "d", flag = "0"),
ratingEloBeta = round(ratingEloBeta, 1)
)
official_ratings <- tibble(
player = c(
5, 1, 237, 17, 12, 16, 224, 30,
68, 154, 97, 39, 85, 2, 202, 1260
),
rankOff = c(
2, 3, 4, 1, 5, 7, 6, 13,
16, 10, 8, 9, 26, 17, 12, 23
),
ratingOff = c(
905750, 878750, 751525, 1315275, 660250, 543225, 590525, 324587,
303862, 356125, 453875, 416250, 180862, 291025, 332450, 215125
)
)
Топ-16 по модели ЭлоБета на конец сезона 2017/18 имеет следующий вид (официальные данные также взяты с сайта snooker.org):
Игрок | ЭлоБета место | ЭлоБета рейтинг | Офиц. место | Офиц. рейтинг | Подъём места по ЭлоБета |
---|---|---|---|---|---|
Ronnie O'Sullivan | 1 | 128.8 | 2 | 905 750 | 1 |
Mark J Williams | 2 | 123.4 | 3 | 878 750 | 1 |
John Higgins | 3 | 112.5 | 4 | 751 525 | 1 |
Mark Selby | 4 | 102.4 | 1 | 1 315 275 | -3 |
Judd Trump | 5 | 92.2 | 5 | 660 250 | 0 |
Barry Hawkins | 6 | 83.1 | 7 | 543 225 | 1 |
Ding Junhui | 7 | 82.8 | 6 | 590 525 | -1 |
Stuart Bingham | 8 | 74.3 | 13 | 324 587 | 5 |
Ryan Day | 9 | 71.9 | 16 | 303 862 | 7 |
Neil Robertson | 10 | 70.6 | 10 | 356 125 | 0 |
Shaun Murphy | 11 | 70.1 | 8 | 453 875 | -3 |
Kyren Wilson | 12 | 70.1 | 9 | 416 250 | -3 |
Jack Lisowski | 13 | 68.8 | 26 | 180 862 | 13 |
Stephen Maguire | 14 | 63.7 | 17 | 291 025 | 3 |
Mark Allen | 15 | 63.7 | 12 | 332 450 | -3 |
Yan Bingtao | 16 | 61.6 | 23 | 215 125 | 7 |
Некоторые наблюдения:
Приведу пример прогнозов модели ЭлоБета. Вероятность того, что игрок №16 (Yan Bingtao) выиграет один фрейм у игрока №1 (Ronnie O'Sullivan) равна 0.404. В матче до 4 побед она падает до 0.299, в "до 10 побед" — 0.197 и в финале Чемпионата Мира до 18 побед — 0.125. По моему мнению, эти значения достаточно близки к реальности.
# Вспомогательные данные
seasons_break <- ISOdatetime(2017, 5, 2, 0, 0, 0, tz = "UTC")
# Вычисление эволюции рейтингов
elobeta_history <- pro_matches_test_off %>%
add_iterative_ratings(elobeta_fun_gen(best_k), initial_ratings = 0) %>%
gather_to_longcr() %>%
left_join(y = pro_matches_test_off %>% select(game, endDate), by = "game")
# Генерирование графика
plot_all_elobeta_history <- function(history_tbl) {
history_tbl %>%
mutate(isTop16 = player %in% elobeta_top16$player) %>%
ggplot(aes(endDate, ratingAfter, group = player)) +
geom_step(data = . %>% filter(!isTop16), colour = "#C2DF9A") +
geom_step(data = . %>% filter(isTop16), colour = "#22A01C") +
geom_hline(yintercept = 0, colour = "#AAAAAA") +
geom_vline(
xintercept = seasons_break, linetype = "dotted",
colour = "#E41A1C", size = 1
) +
geom_text(
x = seasons_break, y = Inf, label = "Конец 2016/17",
colour = "#E41A1C", hjust = 1.05, vjust = 1.2
) +
scale_x_datetime(date_labels = "%Y-%m") +
labs(
x = NULL, y = "Рейтинг ЭлоБета",
title = paste0(
"Большая часть текущего топ-16 определилась в конце сезона 2016/17"
),
subtitle = paste0(
"Победа в турнире хорошо заметна как существенный рост без падения в",
" конце."
)
) +
theme(title = element_text(size = 13))
}
plot_all_elobeta_history(elobeta_history)
Опять кликабельно [28]
# Вычисление данных графика
top16_rating_evolution <- elobeta_history %>%
# Функция `inner_join` позволяет оставить только игроков из `elobeta_top16`
inner_join(y = elobeta_top16 %>% select(-ratingEloBeta), by = "player") %>%
# Оставить матчи только из сезона 2017/18
semi_join(
y = pro_matches_test_off %>% filter(season == 2017), by = "game"
) %>%
mutate(playerLabel = paste(rankChr, playerName))
# Генерирование графика
plot_top16_elobeta_history <- function(elobeta_history) {
ggplot(elobeta_history) +
geom_step(aes(endDate, ratingAfter, group = player), colour = "#22A01C") +
geom_hline(yintercept = 0, colour = "#AAAAAA") +
geom_rug(
data = elobeta_top16,
mapping = aes(y = ratingEloBeta), sides = "r"
) +
facet_wrap(~ playerLabel, nrow = 4, ncol = 4) +
scale_x_datetime(date_labels = "%Y-%m") +
labs(
x = NULL, y = "Рейтинг ЭлоБета",
title = "Эволюция рейтинга ЭлоБета для топ-16 (на конец сезона 2017/18)",
subtitle = paste0(
"Ронни О'Салливан и Марк Уильямс провели успешный сезон 2017/18.n",
"Как и Джек Лисовски: рост с отрицательного рейтинга до 13-го места."
)
) +
theme(title = element_text(size = 13), strip.text = element_text(size = 12))
}
plot_top16_elobeta_history(top16_rating_evolution)
И снова кликабельно [29]
pbeta(p, n, m)
.sessionInfo()
## R version 3.4.4 (2018-03-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 16.04.4 LTS
##
## Matrix products: default
## BLAS: /usr/lib/openblas-base/libblas.so.3
## LAPACK: /usr/lib/libopenblasp-r0.2.18.so
##
## locale:
## [1] LC_CTYPE=ru_UA.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=ru_UA.UTF-8 LC_COLLATE=ru_UA.UTF-8
## [5] LC_MONETARY=ru_UA.UTF-8 LC_MESSAGES=ru_UA.UTF-8
## [7] LC_PAPER=ru_UA.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=ru_UA.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] bindrcpp_0.2.2 comperank_0.1.0 comperes_0.2.0 ggplot2_2.2.1
## [5] purrr_0.2.5 tidyr_0.8.1 dplyr_0.7.6
##
## loaded via a namespace (and not attached):
## [1] Rcpp_0.12.17 knitr_1.20 bindr_0.1.1 magrittr_1.5
## [5] munsell_0.5.0 tidyselect_0.2.4 colorspace_1.3-2 R6_2.2.2
## [9] rlang_0.2.1 highr_0.7 plyr_1.8.4 stringr_1.3.1
## [13] tools_3.4.4 grid_3.4.4 gtable_0.2.0 utf8_1.1.4
## [17] cli_1.0.0 htmltools_0.3.6 lazyeval_0.2.1 yaml_2.1.19
## [21] assertthat_0.2.0 rprojroot_1.3-2 digest_0.6.15 tibble_1.4.2
## [25] crayon_1.3.4 glue_1.2.0 evaluate_0.10.1 rmarkdown_1.10
## [29] labeling_0.3 stringi_1.2.3 compiler_3.4.4 pillar_1.2.3
## [33] scales_0.5.0 backports_1.1.2 pkgconfig_2.0.1
Автор: echasnovski
Источник [30]
Сайт-источник PVSM.RU: https://www.pvsm.ru
Путь до страницы источника: https://www.pvsm.ru/analiz-danny-h/285712
Ссылки в тексте:
[1] модель Эло: https://ru.wikipedia.org/wiki/%D0%A0%D0%B5%D0%B9%D1%82%D0%B8%D0%BD%D0%B3_%D0%AD%D0%BB%D0%BE
[2] Image: https://habr.com/post/416809/
[3] домашнего поля: https://medium.com/@mattbarger/soccer-elo-the-rebuild-df6b58bd8b94
[4] первого хода: https://arxiv.org/pdf/1012.4571.pdf
[5] Snooker Analyst: http://www.snookeranalyst.com/current-ratings/rating-summary/
[6] модель Брэдли–Терри: https://en.wikipedia.org/wiki/Bradley-Terry_model
[7] Данное обсуждение на форуме: https://www.snookerisland.com/forum/viewtopic.php?f=59&t=5585
[8] Это: http://www.llb.su/official/reglament-llb
[9] это: http://billiardnews.com.ua/index.php?option=com_tournaments&view=news&article=419&Itemid=1532
[10] R: https://ru.wikipedia.org/wiki/R_(%D1%8F%D0%B7%D1%8B%D0%BA_%D0%BF%D1%80%D0%BE%D0%B3%D1%80%D0%B0%D0%BC%D0%BC%D0%B8%D1%80%D0%BE%D0%B2%D0%B0%D0%BD%D0%B8%D1%8F)
[11] tidyverse: https://www.tidyverse.org/
[12] здесь: https://github.com/echasnovski/habr-articles/blob/master/articles/001_elo-and-elobeta-models-in-snooker.R
[13] этой статье: https://www.stat.berkeley.edu/~aldous/Papers/me-Elo-SS.pdf
[14] практические особенности: https://en.wikipedia.org/wiki/Elo_rating_system#Practical_issues
[15] задача о разделении ставок: https://en.wikipedia.org/wiki/Problem_of_points
[16] этой статье: https://probabilityandstats.wordpress.com/2016/11/06/the-problem-of-points/
[17] свойство: https://dlmf.nist.gov/8.17#E5
[18] регуляризованной неполной бета-функции: https://ru.wikipedia.org/wiki/%D0%91%D0%B5%D1%82%D0%B0-%D1%84%D1%83%D0%BD%D0%BA%D1%86%D0%B8%D1%8F#%D0%9D%D0%B5%D0%BF%D0%BE%D0%BB%D0%BD%D0%B0%D1%8F_%D0%B1%D0%B5%D1%82%D0%B0-%D1%84%D1%83%D0%BD%D0%BA%D1%86%D0%B8%D1%8F
[19] этом сайте: https://wismuth.com/elo/calculator.html
[20] статью: http://freerangestats.info/blog/2015/08/07/fibs-elo-ratings-basics
[21] описание: http://www.bkgm.com/articles/McCool/ratings.html
[22] русскоязычный аналог: http://ru.2kbgames.com/faq_elo/
[23] comperank: https://cran.r-project.org/web/packages/comperank/index.html
[24] snooker.org: http://www.snooker.org/
[25] инфляции рейтинга: https://en.wikipedia.org/wiki/Elo_rating_system#Ratings_inflation_and_deflation
[26] RMSE: https://en.wikipedia.org/wiki/Root-mean-square_deviation
[27] Image: https://hsto.org/webt/un/ox/40/unox40-c1cmbx_9tm4zc7kqzqoc.png
[28] Image: https://hsto.org/webt/ud/-k/ir/ud-kire5ad6wmun4dmpqm1pxyck.png
[29] Image: https://hsto.org/webt/ov/sk/hh/ovskhhxiqv_xg9aky_vec0_wp_m.png
[30] Источник: https://habr.com/post/416809/?utm_source=habrahabr&utm_medium=rss&utm_campaign=416809
Нажмите здесь для печати.