Построение анимационного линейного графика скользящего среднего в R. Получение данных через NBA API

Продолжим анализировать баскетбольные данные с помощью R.

В отличие от прошлой статьи, носившей исключительно развлекательный характер, графики, которые будут построены в данной заметке, могут быть интересны с точки зрения анализа игры команды походу сезона.

А строить мы будем графики скользящего среднего для трёх видов рейтинга команд НБА: атакующего, оборонительного и net-рейтинга (т.е. разницы между первыми двумя). В двух словах о них. Атакующий и оборонительный рейтинги — это количество очков, набранных/пропущенных командой за 100 владений. NET рейтинг — это их разница также на сто владений. Кому интересно узнать о них более подробно, могут прочитать глоссарий на сайте basketball-reference. Там есть формула расчёта, которую я тоже реализовал с помощью R, но так пока и не опубликовал статью об этом.

Также поясню, почему буду строить график именно скользящего среднего. В каждом отдельном матче слишком велика доля случайности, показатели скачут от 70 до 150, что делает анализ данных бесполезным, а сам график больше напоминает кардиограмму. Если считать кумулятивное среднее, то получается другая крайность: график похож на затухающие колебания, а игры в конце сезона, когда они добавляются к уже проведённым 70-75 матчам, практически не влияют на общий показатель. Грубо говоря, их "не видно". Скользящее среднее в данном случае является выходом из патовой ситуации. С одной стороны уменьшается влияние случайности, с другой не происходит чрезмерного накопления результатов. В баскетбольной статистике обычно делают 10-матчевое скользящее среднее.

Используемые библиотеки

library(httr)
library(jsonlite)
library(tidyverse)
library(lubridate)
library(zoo)
library(ggthemes)
library(gganimate)

Получение данных с помощью NBA API

В прошлый раз я получал данные, используя расширение NBA Data Retriever. В этот раз я буду использовать NBA API, чтобы напрямую загрузить в R нужные данные.

Сначала узнаем, откуда эти данные вытаскивать. Для этого открываем нужную нам страницу на stats.nba.com и заходим в инструменты разработчика. Затем открываем Network -> XHR и нажимаем F5. В появившемся списке находим файл с названием, похожим на название страницы. Он нам и нужен. После того как убедимся, что выбрали правильный файл, копируем его адрес в R. В картинках это выглядит так.

открываем нужный файл

файл должен иметь такой вид

копируем в R адрес

Теперь переходим к работе в R Studio. Для получения нужной нам информации используем функцию GET пакета http. Однако, для того чтобы запрос был выполнен верно (это можно проверить функцией status_code, должно быть 200), нужно добавить заголовки для определения рабочих параметров HTTP-транзакции

##Adding headers
request_headers <- c(
  "accept-encoding" = "gzip, deflate, sdch",
  "accept-language" = "en-US,en;q=0.8",
  "cache-control" = "no-cache",
  "connection" = "keep-alive",
  "host" = "stats.nba.com",
  "pragma" = "no-cache",
  "upgrade-insecure-requests" = "1",
  "user-agent" = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_11_2) AppleWebKit/601.3.9 (KHTML, like Gecko) Version/9.0.2 Safari/601.3.9"
)

#Getting a response
request <- GET(adv_box_team, add_headers(request_headers))

Получаем ответ вот такого вида:

Но пока нужных нам данных не видно. Чтобы их получить мы сначала извлекаем функцией content содержимое запроса в json-файл, а затем конвертируем его в список функцией из пакета jsonlite с говорящим названием fromJSON

boxscore_data <- fromJSON(content(request, as = "text"))

В итоге мы получаем список, в котором уже содержится вся необходимая нам информация и дальше мы просто приводим его в тот вид, который нужен для работы.

Подготовка данных

Для этого сделаем вместо списка таблицу данных, а затем добавим заголовки столбцов.

#Convert to tibble data and assigning column names
table <- tbl_df(data.frame(boxscore_data$resultSets$rowSet[[1]], 
stringsAsFactors = FALSE))
names(table) <- toupper(boxscore_data$resultSets$headers[[1]])

toupper — это функция, которая заменяет все символы на заглавные. После этого у нас должна получится таблица с 2460 строками и 46 столбцами. В принципе, можно работать с таблицей и в таком виде, но лучше исключить лишнюю информацию, для более удобной и быстрой работы.

##Select the columns you want to analyze
rating <- table %>%
  select(TEAM_ID,
         TEAM_ABBREVIATION,
         TEAM_NAME,
         GAME_ID,
         GAME_DATE,
         MATCHUP,
         WL,
         E_OFF_RATING,
         E_DEF_RATING,
         E_NET_RATING)

Если посмотреть исходную таблицу, то можно увидеть два вида одного и того же рейтинга: "обычный" и с приставкой E. Не вдаваясь в подробности E-рейтинг учитывает темп игры, поэтому является более точным. Его и берём.

Дальше я хочу упростить названия рейтингов. Их надо будет вводить в аргументы функции и лучше использовать более привычные широкому кругу пользователей обозначения: ORTG, DRTG, NRTG. Здесь можно "заморочиться" с написанием регулярного выражения и замены с помощью str_replace, но их написание то ещё удовольствие и здесь мы прекрасно можем обойтись без них. Нам просто нужно извлечь 3, 7, 9 и 12 символ текущих названий, объединить их и заменить названия столбцов на получившийся символьный вектор. Всё это делаем с помощью функций пакета stringr: str_sub и str_c (аналог базового paste0).

## Renaming columns with E_OFF_RATING on ORTG
rating1 <- rating %>%
  rename_at(vars(starts_with("E_")),
            list(~str_c(str_sub(., start = 3, end = 3), 
                        str_sub(., start = 7, end = 7),
                        str_sub(., start = 9, end = 9),
                        str_sub(., start = 12, end = 12))))

at в функциях пакета dplyr имеет тоже свойство, что и конструкция dt[, lapply(.SD, func), .SDols = col1] в пакете data.table: действие применяется к нескольким столбцам одновременно. Здесь мы выбираем все столбцы, название которых начинается с "E_".

В итоге, у нас получается вот такая таблица, с которой в дальнейшем мы и будем работать:

Функция rolling_offnet_rating_nba для построения графика и анимации скользящего среднего.

Снова, как и прошлый раз, создадим функцию, чтобы делать минимальные изменения при вычислениях.

Функция rolling_offnet_rating_nba имеет такой вид:

rolling_offnet_rating_nba <- function(table, name, variable, col1 = col1, col2 = col2)

table — это название таблицы с данными,
name — аббревиатура команды, для которой будут делаться графики ("BOS", "LAL" и т.п.).
variable — рейтинг, который будет рассчитываться (здесь два варианта, ORTG или NRTG, для защитного рейтинга я сделал отдельную функцию)
col1 и col2 — цвет линии при значении выше/ниже среднего.

Большинство функций dplyr используют нестандартную оценку (non-standard evaluation (NSE)). Это общий термин, означающий, что их оценка отличается от обычной оценки в R. Это позволяет упрощать запись кода и работать с SQL-базами, но минусом является то, что мы не можем заменить значение на эквивалентный объект, определённый в другом месте.

В dplyr используется Tidy evaluation. Поэтому приходится применять особые инструменты (функции цитирования, оператор !!) чтобы решить возникающие проблемы при программировании. Подробнее об этом вы можете прочитать здесь, а посмотреть здесь.

Следующий код принимает имя аргумента функции и записывает выражение, которое было ему представлено. (Для понимания работы функций enquo и ей подобных, полезно печатать вывод этой функции)

##Return the entered value in the function argument in the type quosure
   quo_rating <- enquo(variable)
   quo_col1 <- enquo(col1)
   quo_col2 <- enquo(col2)

Дальше изменяем формат данных у некоторых столбцов: GAME_DATE из символьного делаем столбцом в формате Date, а столбцы рейтингов делаем числовыми. Т.к. мы применяем функцию as.numeric к трём столбцам, то вместо mutate используем mutate_at. И всё сортируем в порядке возрастания даты.

##Changing the data type of multiple columns
   test1 <- table %>%
     mutate(GAME_DATE = as.Date(ymd_hms(GAME_DATE))) %>%
     mutate_at(vars(ORTG:NRTG), list(~as.numeric)) %>%
     arrange(GAME_DATE)

А дальше мы вычисляем 10-матчевое скользящее среднее нужной нам команды. Для этого используем функцию rollmeanr из пакета zoo. r в конце названия означает, что результат должен быть выровнен по правому краю. Для первых девяти игр сезона скользящее 10-матчевое среднее рассчитать просто невозможно, поэтому мы оставляем эти поля без значений, заполняя их NA с помощью аргумента fill. na.omit удаляет из таблицы строки, в которых эти NA встречаются.

##The calculation of the moving average  
   team <- test1 %>%
     filter(TEAM_ABBREVIATION == "DAL") %>%
     mutate(RATING = rollmeanr(ORTG, k = 10, fill= NA)) %>%
     na.omit(test1)

Таблица team выглядит так:

В принципе, нужную нам информацию мы уже получили. Можно с помощью двух строчек кода построить линейный график. Но чёрная линия на белом фоне представляет мало интереса как с эстетической, так и с информативной точки зрения. Дальнейшая часть "тела функции" это исправляет.

Для начала добавим данные о среднем, 10-ом и 21-ом (десятом снизу) значении рейтинга, а также дату 10 матча команды (т.е. первого для которого посчитано скользящее среднее и который остался в таблице team после удаления строк с NA).

##The average, 10 and 21 ratings in the entire League.   
  average <- league %>%
    mutate(average = mean(!! quo_rating)) %>%
    select(average) %>%
    unique() %>%
    .$average

   top10 <- league %>%
     arrange(desc(!! quo_rating)) %>%
     select(!! quo_rating) %>%
     slice(10)
   top10 <- top10[[1]]

  bottom10 <- league %>%
    arrange(desc(!! quo_rating)) %>%
    select(!! quo_rating) %>%
    slice(21)
  bottom10 <- bottom10[[1]]

##Getting the date of the first rollaverage  
  data <- team %>%
    select(GAME_DATE) %>%
    arrange(GAME_DATE)
  data <- data[[1,1]]

Из ранее неиспользованных функций здесь появляется функция slice которая выбирает строки по их порядковому номеру.

Дальше мы выбираем 2 цвета и их название. Данные, как и в прошлый раз, берём из таблицы table_color. Название будет использоваться в заголовке графика, для объяснения какой из цветов соответствует значениям ниже среднего, а какой выше.

##Getting color and color_name selected color
  color1 <- table_color %>%
    filter(TEAM_ABBREVIATION == name) %>%
    select(!! quo_col1)
  color1 <- color1[[1]]

  color2 <- table_color %>%
    filter(TEAM_ABBREVIATION == name) %>%
    select(!! quo_col2)
  color2 <- color2[[1]]

  name1 <- paste0("name_", quo_name(quo_col1))
  name2 <- paste0("name_", quo_name(quo_col2))

  name_color1 <- table_color %>%
    filter(TEAM_ABBREVIATION == name) %>%
    select(name1)
  name_color1 <- name_color1[[1]]

  name_color2 <- table_color %>%
    filter(TEAM_ABBREVIATION == name) %>%
    select(name2)
  name_color2 <- name_color2[[1]]

В аргументах функции по умолчанию стоят значения col1 и col2, это первый и второй цвета команд. В большинстве случаев (точнее в 26), эти значения менять не надо, однако у четырёх команд следует использовать следующий цвет в их цветовой палитре. У Далласа и Миннесоты первый и второй цвета слишком похожи, а у Милуоки и Бруклина не видны на белом фоне. И то, и другое затрудняет чтение графика, поэтому для них стоит использовать аргумент col2 = col3.

Дальше получим максимальное значение рейтинга для команды. Это значение понадобится нам для расположения текста со значением рейтинга на графике. Хочу обратить внимание на последнюю строчку кода. Так получилось, что функции прекрасно строили графики в 89 из 90 случаев, но при построении защитного рейтинга Милуоки выдавали ошибку. Оказалось, что максимальное значение рейтинга у Милуоки достигается дважды и ggplot2 закономерно начинает ругаться на то, что aesthetic должен быть, в нашем случае, либо 1, либо 73. Поэтому нам нужно единственное максимальное значение рейтинга.

##The maximum value of the rating
  max <- team %>%
    filter(RATING == max(RATING)) %>%
    select(RATING)
  max <- max[[1]]

Построение статичного графика в ggplot2

##Building and save a static chart
  Sys.setlocale("LC_ALL", "C")
  gg <- ggplot(team, aes(GAME_DATE, RATING)) +
     geom_hline(yintercept = c(top10, bottom10), col = c("red", "blue")) +
     annotate(geom = "text", x = as.Date(data) + 2, y = top10 - 0.2,
              label = "TOP 10", col = "red") +
     annotate(geom = "text", x = as.Date(data) + 2, y = bottom10 + 0.2,
              label = "BOTTOM 10", col = "blue") +
     geom_line(size = 2, col = if_else(team$RATING > average, color1, color2)) +
     theme_tufte() +
     labs(title = paste0(team$TEAM_NAME, " 
     10-Game Rolling ", quo_name(quo_rating)),
     subtitle = paste0(paste0(name_color1, " - above average ", 
                                          quo_name(quo_rating)),
                       "n", paste0(name_color2, " - below average ",
                                          quo_name(quo_rating))),
     caption = "Source: BBall Index Data & ToolsnTelegram: @NBAatlantic, 
     twitter: @vshufinskiy")
     theme(plot.title = element_text(size = 12, hjust = 0.5),
          plot.caption = element_text(size = 10),
          plot.subtitle = element_text(size = 9))
   ggsave(paste0(unique(team$TEAM_NAME), quo_name(quo_rating), ".jpeg"),
 gg, width = 8, units = "in")

Из нового здесь использование функции if_else для изменения цвета линии в зависимости от того, выше или ниже значение рейтинга среднего по Лиге, а также первая строчка, изменяющая локаль. Сделано это для того, чтобы аббревиатуры названия месяцев по оси X были написаны на английском.

Построение анимации 10-матчевого скользящего среднего.

В построении анимации я добавил несколько примочек, которые невозможны в статичной версии. Во-первых, меняющаяся дата (аналогично тому, как в прошлой статье менялся год), а также значение рейтинга в конкретный момент времени. Он также меняет цвет в зависимости от того, выше или ниже среднего значения.

##Building animations
  anim <- gg +
    theme(plot.title = element_text(hjust = 0.5, size = 25),
          plot.subtitle = element_text(size = 15),
          plot.caption = element_text(size = 15),
          axis.text = element_text(size = 15),
          axis.title = element_text(size = 18)) +
    geom_text(aes(x = as.Date(data), y = max + 0.5),
              label = paste0(quo_name(quo_rating)," ", round(team$RATING, digits = 1)), size = 6,
              col = if_else(team$RATING > average, color1, color2)) +
    transition_reveal(GAME_DATE) +
    labs(title = paste0(team$TEAM_NAME, " 10-Game Rolling ", quo_name(quo_rating)),
         subtitle = paste0(paste0(name_color1, " - above average ",quo_name(quo_rating)),
                           "n", paste0(name_color2, " - below average ",quo_name(quo_rating)),
                           "n", "Date: {frame_along}"),
         caption = paste0("Source: stats.nba.comnTelegram: @NBAatlantic, twitter: @vshufinskiy"))

Результат

На графике довольно очевидно, что Даллас просел во второй половине февраля-марте. Объяснение этому очень простое: именно в этот момент сезона Маверикс обменяли 4 из 5 игроков своей стартовой пятёрки, а главный пришедший актив, латыш Кристапс Порзингис, не сыграл из-за разрыва крестообразных связок ни минуты.

Здесь я не буду углубляться в спортивную составляющую, так что если кому интересно посмотреть остальные 89 графиков сезона 2018-19, то милости прошу в мой блог на sports.ru, где я планирую написать статью с обзором самых интересных из них или в мой Телеграм-канал о НБА, где я собираюсь выложить их все.

Репозиторий на GitHub

Автор: Gers1972

Источник