Визуализация количества побед у команд НБА с помощью анимационных столбиковых диаграмм в 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: @vshufiskiyn
         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: @vshufiskiynData 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 "По обе стороны Атлантики"

Автор: Gers1972

Источник