Визуализация количества побед у команд НБА с помощью анимационных столбиковых диаграмм в R

Для начала небольшая вводная информация. Меня зовут Владислав и моё знакомство с R состоялось в августе прошлого года. Изучать язык программирования я решил по причине прикладного характера. Мне с детства нравилось вести спортивную статистику. С возрастом это увлечение трансформировалось в желание как-то анализировать эти цифры и на основе анализа данных выдавать, по возможности, умные мысли. Проблема в том, что спорт в последние годы захлестнула волна данных, десятки компаний соревнуются между собой, пытаясь посчитать, описать и запихнуть в нейронку любое действие футболиста, баскетболиста, бейсболиста на площадке. И Excel для анализа не подходит категорически. Так что я решил изучать R, чтобы простейший анализ не занимал полдня. Уже в ходе изучения добавился интерес к программированию как таковому, но это уже лирика.

Хочу сразу заметить, что многое из того, что я напишу в дальнейшем уже было в Симпсонах было на Хабре в статье Создаем анимированные гистограммы при помощи R. Эта статья, в свою очередь, является переводом статьи Create Trending Animated Bar Charts using R с Medium. Поэтому, чтобы как-то отличаться от вышеуказанных статей я постараюсь более полно описывать, чтоя делаюа, а также те моменты, которых нет в оригинальной статье. Например, для заливки столбцов я использовал цвета команд НБА, а не стандартную палитру ggplot2, а в обработке данных пакет data.table, а не dplyr. Всё это дело у меня сделано в виде функции, так что теперь достаточно просто написать название команды и годы, за которые нужно количество побед посчитать.

Данные

Для построения графика я использовал данные о количестве побед каждой из 30 команд НБА в последних 15 сезонах. Собраны они были с сайта stats.nba.com с помощью расширения NBA Data Retriever, которое через использование NBA API выдаёт csv-файлы с необходимой статистикой. Вот полные данные из моего проекта на Github.

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

library(data.table)
library(tidyverse)
library(gganimate)

Для обработки данных я использую data.table (просто потому, что познакомился с этим пакетом раньше). Также я загружаю набор пакетов tidyverse, а не отдельный ggplot2 чтобы не переживать, если вдруг в ходе анализа появиться какая-то идея, требующая дополнительную загрузку пакета из этого набора. В данном конкретном случае можно обойтись и ggplot2, другие пакеты набора не участвуют. Ну и gganimate "придаёт" приводит графики в движение.

Работа с данными

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

Таблица в data.table имеет вид dt[i, j, by], где by "ответственно" за группировку элементов. Группировать я буду по столбцу TeamName. И здесь есть загвоздка. В этом столбце отображаются названия команд: Lakers, Celtics, Heat и т.д. Но за рассматриваемый период (с сезона 2004/05) несколько команд поменяли названия: New Orleans Hornets стали New Orleans Pelicans, Charlotte Bobcats вернули историческое название Charlotte Hornets, а Seattle Supersonics стали Oklahoma City Thunder. Из-за этого может возникнуть путаница. Следующие преобразования помогают этого избежать:

table1 <- table[TeamCity == "New Orleans" & TeamName == "Hornets", 
                TeamName := "Pelicans"][
                TeamCity == "New Orleans/Oklahoma City" & TeamName == "Hornets",
                TeamName := "Pelicans"][
                TeamName == "Bobcats", TeamName := "Hornets"][
                TeamName == "SuperSonics", TeamName := "Thunder"]

Для данного временного отрезка изменения минимальны, но если его расширить, то по TeamName группировать станет очень сложно и надо будет пользоваться более надёжным столбцом. В этих данных это TeamID.

Для начала избавляемся от "лишней" информации, оставляя только те столбцы, которые понадобятся нам для работы:

table1 <- table1[ , .(TeamName, WINS)]

В data.table конструкция .() заменяет собой функцию list. Более "классический" вариант выбора столбцов это table1 <- table1[, c("TeamName", "WINS")]. После этого таблица приобретает следующий вид:

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

table1 <- table1[, CumWins := cumsum(WINS), by = "TeamName"]

С помощью функции cumsum мы получаем нужные нам числа. Использование := вместо = позволяет добавить новый столбец к таблице, я не перезаписать её с одни столбцом CumWins. by = "TeamName" группирует данные по имени команды и кумулятивная сумма считается для каждой из 30 команд в отдельности.

Далее я добавляю столбец с годом, когда начинался каждый сезон. Сезон в НБА идёт с октября по май, так что попадает на два календарных года. В обозначении сезона год его начала, т.е. Season: 2018 на графике это сезон 2018/19 в реальности.

В изначальной таблице есть эти данные. В столбце SeasonID представлены цифра в виде 2(год начала сезона), например, 22004. Можно убрать первую двойку с помощью пакета stringr или базовых функций R, но я пошёл немного другим путём. У меня получилось, что я сначала использую этот столбец для указания необходимых сезонов, потом удаляю и создаю столбец с датами вновь. Лишние действия.

Я сделал это следующим образом:

table1 <- table1[,year := rep(seq(2004, 2018), each = length(unique(table1$TeamName)))]

Мне "повезло", что за выбранный временной промежуток количество команд в НБА не менялось, поэтому я просто повторил цифры от 2004 до 2018 30 раз. Опять-таки если уходить в историю, то такой способ будет неудобен из-за того, что количество команд в каждом сезоне будет разным, поэтому предпочтительнее использовать вариант с очисткой столбца SeasonID.

Затем добавляем столбец cumrank.

table1 <- table1[, cumrank := frank(-CumWins, ties.method = "random"), by = "year"]

Он представляет собой ранжирование команд в каждом сезоне по количеству побед и будет использоваться как значения оси X. frank более быстрый data.table аналог базового rank, минус означает ранжирование в порядке убывания (также это можно сделать с помощью аргумента decreasing = TRUE. Мне неважно в каком порядке будут идти команды с одинаковым числом побед, поэтому ties.method = "random". Ну и всё это группируется в рамках одного года.

И последнее преобразование таблицы — это добавление столбца value_rel.

table1 <- table1[, value_rel := CumWins/CumWins[cumrank==1], by = "year"]

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

После всех добавлений таблица имеет следующий вид:

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

table1 <- table1[
  ,.(TeamName, WINS)][
    , CumWins := cumsum(WINS), by = "TeamName"][
      ,year := rep(seq(2004, 2018), each = length(unique(table1$TeamName)))][
        , cumrank := frank(-CumWins, ties.method = "random"), by = "year"][
          , value_rel := CumWins/CumWins[cumrank==1], by = "year"]

Изменение заливки столбцов со стандартной на цвета команд.

Можно сразу перейти к построению графиков, но есть ещё, как мне кажется, один важный момент: цвет столбцов на графике. Можно оставить стандартную палитру ggplot2, но это плохой вариант. Во-первых, как мне кажется, она некрасива. А во-вторых, затрудняет поиск команды на графике. У поклонников НБА каждая из команд ассоциируется с определенным цветом: Бостон — это зелёный, Чикаго — красный, Сакраменто — фиолетовый и т.д. Поэтому использование цвета команды в заливке столбцов помогает быстрее её идентифицировать, несмотря на обилие синего и красного.

Для этого создаём таблицу table_color с названием команды и главным её цветом. Цвета взяты с сайта teamcolorcodes.com.

С таблицей цветов нужно сделать ещё одну манипуляцию. Т.к. при построении графика используются факторы, то порядок команд измениться. Первой в списке будет идти Филадельфия 76, как единственный обладатель "цифрового" имени, а далее согласно алфавиту. Так что нам и цвета нужно расположить в том же порядке, а затем извлечь из таблицы вектор, их содержащий. Я сделал это следующим образом:

  table_color <- table_color[order(TeamName)]
  cols <- table_color[, "TEAM_color"]

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

Мы действительно строим всего один график, который содержит все 450 (15 сезонов * 30 команд) показателей побед, а затем "разделяем" его по необходимой переменной (в нашем случае по годам) с помощью функций из пакета gganimate.

gg <- ggplot(table1, aes(cumrank, group = TeamName, fill = as.factor(TeamName),
                           color = as.factor(TeamName))) + 
      geom_tile(aes(y = CumWins/2,
                        height = CumWins,
                        width = 0.7), color = NA, alpha = 0.8)

Сначала мы создаём графический объект с помощью функции ggplot. В аргументе aes указываем, как переменные из таблицы будут отображаться на графике. Мы их группируем по TeamName, fill и colorбудут отвечать за цвет столбцов.

Правда столбцами называть это не совсем верно. С помощью geom_tile мы "разделяем" данные на графике на прямоугольники. Вот пример диаграммы такого типа:

Видно, как график "поделён" на квадраты (они получаются из прямоугольников при использовании слоя coord_equal()), по три в каждом столбце. Но благодаря аргументу width меньше единицы наша плитка принимает вид столбиков.

    geom_text(aes(y = 0, label = paste(TeamName, " ")), vjust = 0.2, 
    hjust = 1, size = 6) +
    geom_text(aes(y = CumWins, label = paste0(" ",round(CumWins))), 
    hjust = 0, size = 7) +
    coord_flip(clip = "off", expand = FALSE) +
    scale_fill_manual(values = cols) +
    scale_color_manual(values = cols) +
    scale_y_continuous(labels = scales::comma) +
    scale_x_reverse() +
    guides(color = FALSE, fill = FALSE) +

Далее я добавляю две подписи с помощью geom_text: название команды и число побед. coord_flip меняет оси местами, scale_fill_manual и scale_color_manual меняют цвет столбцов, scale_x_reverse"разворачивает" ось Х. Заметьте, ч то цвета мы берём из ранее созданного вектора cols.

В слое theme указываются параметры для настройки отображения графика. Здесь указано, как должны отображаться заголовки и подписи осей (никак, о чём нам говорит element_blank в правой части равенства). Мы убираем легенду, фон, рамку, линии сетки по оси Y. Аргументами plot.title, plot.subtitle, plot.caption мы задаём параметры отображения заголовка, подзаголовка и подписи графика. Более подробно значение всех параметров можно посмотреть на сайте gglot2

theme(axis.line=element_blank(),
          axis.text.x=element_blank(),
          axis.text.y=element_blank(),
          axis.ticks=element_blank(),
          axis.title.x=element_blank(),
          axis.title.y=element_blank(),
          legend.position="none",
          panel.background=element_blank(),
          panel.border=element_blank(),
          panel.grid.major=element_blank(),
          panel.grid.minor=element_blank(),
          panel.grid.major.x = element_line( size=.1, color="grey" ),
          panel.grid.minor.x = element_line( size=.1, color="grey" ),
          plot.title=element_text(size=25, hjust=0.5, face="bold", 
          colour="black", vjust=-1),
          plot.subtitle = element_text(size = 15),
          plot.caption =element_text(size=15, hjust=0.5, color="black"),
          plot.background=element_blank(),
          plot.margin = margin(2,2, 2, 4, "cm"))

Создание анимации

На использовании функции transition_states я останавливаться не буду, эта часть у меня идентична более ранней публикации на Хабре. Что касается labs то он создаёт заголовок, подзаголовок и подпись графика. Использование {closest_state} позволяет отображать на графике каждый конкретный год, столбцы из которого мы видим в данный момент.

  anim <- gg + transition_states(year, transition_length = 4, state_length = 1) +
    view_follow(fixed_x = TRUE)  +
    labs(title = "Cumulative Wins by teams in seasons",
         subtitle =  "Season: {closest_state}",
         caption  = "Telegram: @NBAatlantic, Twitter: @vshufiskiy\n
         Data sourse: stats.nba.com")

Функция nba_cumulative_wins для создания графиков.

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

имя_функции <- function(аргументы функции) {
      тело_функции
}

Для начала стоит понять, какие параметры Вы хотите менять с помощью функции, от этого будут зависеть её аргументы. Первый аргумент — это имя таблицы с данными, которая подаётся на вход. Это позволяет переименовать её, если возникнет такое желание, при этом ничего не меняя в самой функции. Также я хочу, чтобы на графике могло отображаться любое число команд: от одной (что бессмысленно) до 30 (больше просто нет). Так же мне хочется иметь возможность рассматривать любые временные периоды в рамках тех 15 лет, по которым у меня есть данные. Всё это реализовывается в таком виде функции:

nba_cumulative_wins <- function(table, elements, first_season, last_season){
...
}

где table — имя таблицы с входными данными,
elements — названия тех команд, которые должны отображаться на графике
first_season — первый сезон, который будет отображаться на графике
last_season — последний сезон, который будет отображаться на графике.

Если аргумент очень часто используется с каким-то определённым значением, то можно задать его по умолчанию. Тогда, если среди аргументов функции он пропущен, то будет подставляться это значение. Например, если прописать

nba_cumulative_wins <- function(table, elements, first_season, last_season = 2018)

то графики будут строиться вплоть до сезона 2018/19, если не указано иное.

Работа с аргументами elements, first_season, last_season

С помощью аргумента elements мы можем указать название тех команд, которые мы хотим видеть на графике. Это очень удобно, когда таких команд 2 или 3, но если мы хотим отобразить всю лигу нам придётся написать elements = c() и в скобочках название всех 30 команд.

Поэтому я решил "разделить" входные значения для аргумента elements на несколько групп.
Функция nba_cumulative_wins может строить графики для отдельных команд, дивизионов, конференций или НБА в целом. Для этого мною была использована следующая конструкция:

  select_teams <- unique(table1$TeamName)
  select_div <- unique(table1$Division)
  select_conf <- unique(table1$Conference)
  select_nba <- "NBA"

  table1 <- if(elements %in% select_teams){
    table1[TeamName %in% elements]
  } else if (elements %in% select_div){
    table1[Division %in% elements]
  } else if(elements %in% select_conf){
    table1[Conference %in% elements]
  } else if(elements == "NBA"){
    table1
  } else {
    NULL
  }

Символьные вектора select_ содержат в себе названия всех 30 команд, 6 дивизионов, 2 конференций и НБА, а функция unique оставляет только одно уникальное название, вместо 15 (по количеству лет в данных).

Дальше с помощью конструкции if...else проверяется принадлежность введённого аргумента elements к одному из классов (%in% используется для определения принадлежности элемента вектору), и в соответствии с этим видоизменяется таблица с данными. Теперь, если я хочу посмотреть результаты команд, играющих в Юго-западном дивизионе вместо

elements = c("Mavericks", "Spurs", "Rockets", "Grillies", "Pelicans")

мне достаточно ввести

elements = "Southwest", что гораздо быстрее и удобнее.

Из-за возможности выбора сезонов изменяется и работа с датами. В самом начале добавляется строка:

table1 <- table1[SeasonID >= as.numeric(paste(2, first_season, sep = "")) 
& SeasonID <= as.numeric(paste(2, last_season, sep = ""))]

Так я оставляю в таблице только те строки, которые попадают в выбранный нами временной интервал. Также изменяется и код для создания столбца year. Теперь он выглядит так:

table1 <- table1[ ,year := rep(seq(first_season, last_season), 
each = length(unique(table1$TeamName)))]

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

 elements1 <- if (elements == "NBA"){
    c("Hawks", "Celtics", "Nets", "Hornets", 
      "Bulls", "Cavaliers", "Mavericks", 
      "Nuggets", "Pistons", "Warriors", "Rockets", 
      "Pacers", "Clippers", "Lakers", "Grizzlies",
      "Heat", "Bucks", "Timberwolves", "Pelicans", 
      "Knicks", "Thunder", "Magic", "76ers", "Suns", 
      "Trail Blazers","Kings", "Spurs", "Raptors", 
      "Jazz", "Wizards")
  } else if (elements == "West") {
    c("Mavericks","Nuggets", "Warriors", "Rockets", 
      "Clippers", "Lakers", "Grizzlies","Timberwolves", 
      "Pelicans", "Thunder", "Suns", "Trail Blazers","Kings", "Spurs", 
      "Jazz")
  } else if (elements == "East") {
    c("Hawks", "Celtics", "Nets", "Hornets", 
      "Bulls", "Cavaliers","Pistons", "Pacers",
      "Heat", "Bucks", "Knicks", "Magic", "76ers",
      "Raptors", "Wizards")
  } else if (elements == "Pacific") {
    c("Warriors", "Clippers", "Lakers", "Suns", "Kings")
  } else if (elements == "Southeast") {
    c("Magic", "Hornets", "Heat", "Hawks", "Wizards")
  } else if (elements == "Southwest") {
    c("Mavericks", "Grizzlies", "Pelicans", "Rockets", "Spurs")
  } else if (elements == "Central") {
    c("Bucks", "Pacers", "Pistons", "Bulls", "Cavaliers")
  } else if (elements == "Atlantic") {
    c("Knicks", "Nets", "Celtics", "Raptors", "76ers")
  } else if (elements == "Northwest") {
    c("Nuggets", "Trail Blazers", "Jazz", "Thunder", "Suns")
  } else {
    elements
  }

Далее создаём таблицу с названиями команд, которые нам необходимы, соединяем эту таблицу с table_color с помощью функции inner_join из пакета dplyr. inner_join включает только наблюдения, которые совпадают в обеих таблицах.

  table_elements1 <- data.table(TeamName = elements1)

  table_color <- table_color[order(TeamName)]
  inner_table_color <- inner_join(table_color, table_elements1)

  cols <- inner_table_color[, "TEAM_color"]

В функции изменяется написание заголовка и подзаголовка. Они приминают такой вид:

anim <- gg + transition_states(year, transition_length = 4, state_length = 1) +
    view_follow(fixed_x = TRUE)  +
    labs(title = paste("Cumulative Wins by teams in seasons", 
                       first_season, "-", last_season, sep = " "),
         subtitle = paste(if (elements %in% select_div ){
           paste(elements, "Division", sep = " ")
         } else if (elements %in% select_conf ){
           paste("Conference", elements, sep = " ")
         }, "Season: {closest_state}", sep = " "),
         caption  = "Telegram: @NBAatlantic, Twitter: @vshufiskiy\nData sourse: stats.nba.com")

Рендеринг

Далее всё это визуализируется.

animate(anim, 
        nframes = (last_season - first_season + 1) *
        (length(unique(table1$TeamName)) + 20),
        fps = 20,  width = 1200, height = 1000, 
        renderer = 
        gifski_renderer(paste(elements[1], "cumwins.gif", sep = "_")))

число в nframes я подобрал опытным путём, чтобы в зависимости от количества выбранных команд увеличивалась/уменьшалась скорость.

График

Надеюсь мой пост получился интересным. Код проекта на Github.

Если Вам интересна спортивная составляющая данных визуализаций, то можете посетить мой блог на sports.ru "По обе стороны Атлантики"