Construindo um gráfico de linha de média móvel animado em R. Recuperando dados através da API da NBA

Continuamos a analisar dados de basquete usando R.


Ao contrário do artigo anterior, que era puramente divertido, os gráficos que serão construídos neste artigo podem ser interessantes do ponto de vista da análise do jogo da equipe na campanha da temporada.


E criaremos gráficos de média móvel para três tipos de classificação de equipes da NBA: ataque, defesa e classificação por rede (ou seja, a diferença entre os dois primeiros). Em poucas palavras sobre eles. Classificações de ataque e defesa são o número de pontos marcados / perdidos por uma equipe por 100 posses. NET - essa é a diferença para cem posses. Qualquer pessoa interessada em aprender mais sobre eles pode ler o glossário sobre referências de basquete . Existe uma fórmula de cálculo, que também implementei usando R, mas ainda não publiquei um artigo sobre o assunto.


Também vou explicar por que vou construir o gráfico da média móvel. Em cada partida individual, a proporção de aleatoriedade é muito alta, os indicadores saltam de 70 para 150, o que torna a análise de dados inútil e o próprio gráfico é mais como um cardiograma. Se tomarmos a média cumulativa, teremos outro extremo: o cronograma é semelhante a flutuações atenuadas e os jogos no final da temporada, quando somados a partidas já realizadas de 70 a 75, praticamente não afetam o indicador geral. Grosso modo, eles "não são visíveis". A média móvel nesse caso é a saída do impasse. Por um lado, a influência do acaso diminui, por outro lado, não há acúmulo excessivo de resultados. Nas estatísticas do basquete, eles costumam fazer uma média móvel de 10 partidas.


Bibliotecas usadas


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

Recuperando dados usando a API da NBA


Na última vez, recuperei dados usando a extensão NBA Data Retriever . Desta vez, usarei a API da NBA para carregar diretamente os dados necessários no R.


Primeiro, descobrimos de onde obter esses dados. Para fazer isso, abra a página que precisamos em stats.nba.com e acesse as ferramentas do desenvolvedor. Em seguida, abra Rede -> XHR e pressione F5. Na lista que aparece, encontramos um arquivo com um nome semelhante ao nome da página. Nós precisamos dele. Após certificar-se de que você selecionou o arquivo correto, copie o endereço em R. Nas figuras, ele se parece com isso.


abra o arquivo desejado



o arquivo deve ficar assim



copiar para o endereço R



Agora vamos trabalhar no R Studio . Para obter as informações necessárias, usamos a função GET do pacote http . No entanto, para que a solicitação seja executada corretamente (isso pode ser verificado pela função status_code , ela deve ser 200), você precisa adicionar cabeçalhos para determinar os parâmetros de trabalho da transação 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)) 

Temos uma resposta como esta:



Mas enquanto os dados que precisamos não são visíveis. Para obtê-los, primeiro extraímos o content solicitação pelo content da função em um arquivo json e depois o convertemos em uma lista com uma função do pacote jsonlite com o nome falado de fromJSON


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

Como resultado, obtemos uma lista que já contém todas as informações necessárias e, em seguida, simplesmente as trazemos para o formulário necessário para o trabalho.


Preparação de dados


Para fazer isso, crie uma tabela de dados em vez de uma lista e adicione cabeçalhos de coluna.


 #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 é uma função que substitui todos os caracteres por maiúsculas. Depois disso, devemos obter uma tabela com 2460 linhas e 46 colunas. Em princípio, você pode trabalhar com a tabela neste formulário, mas é melhor excluir informações desnecessárias, para um trabalho mais conveniente e rápido.


 ##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) 

Se você olhar para a tabela de origem, poderá ver dois tipos da mesma classificação: “normal” e com o prefixo E. Sem entrar em detalhes, a classificação E leva em consideração o ritmo do jogo, portanto, é mais preciso. Nós aceitamos.


Em seguida, quero simplificar os nomes das classificações. Eles precisarão ser introduzidos nos argumentos da função e é melhor usar a notação mais familiar para uma ampla gama de usuários: ORTG, DRTG, NRTG. Aqui você pode "ficar confuso" ao escrever uma expressão regular e substituí-la por str_replace , mas escrevê-las ainda é um prazer e aqui podemos fazer sem elas perfeitamente. Só precisamos extrair os 3, 7, 9 e 12 caracteres dos nomes atuais, combiná-los e substituir os nomes das colunas pelo vetor de caracteres resultante. Tudo isso é feito usando as funções do pacote str_sub : str_sub e str_c (um análogo da 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 nas funções do pacote, dplyr possui a mesma propriedade que a construção dt[, lapply(.SD, func), .SDols = col1] no pacote data.table : a ação é aplicada a várias colunas ao mesmo tempo. Aqui, selecionamos todas as colunas cujo nome começa com "E_".


Como resultado, obtemos uma tabela com a qual continuaremos trabalhando:


TEAM_IDTEAM_ABBREVIATIONTEAM_NAMEGAME_IDGAME_DATEMATCHUPWlORTGDRTGNRTG
1610612749MilMilwaukee bucks00218012262019-04-10T00: 00: 00MIL vs. OkcL102,4116,8-14,4
1610612766ChaCharlotte hornets00218012222019-04-10T00: 00: 00CHA vs. ORLL121,4130,1-8,6
1610612758SACReis de Sacramento00218012302019-04-10T00: 00: 00SAC @ PORL129,7136,4-6,8
1610612748MIAMiami heat00218012212019-04-10T00: 00: 00MIA @ BKNL84,2103,6-19,4
1610612750MINMinnesota timberwolves00218012282019-04-10T00: 00: 00MIN @ DENL98,3103,7-5,4

A função rolling_offnet_rating_nba para plotar e animar uma média móvel.


Novamente, como da última vez, vamos criar uma função para fazer alterações mínimas nos cálculos.


A função rolling_offnet_rating_nba com isso:


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

table é o nome da tabela de dados,
nome - a abreviação da equipe para a qual os gráficos serão criados ("BOS", "LAL" etc.).
variável - a classificação que será calculada (aqui estão duas opções, ORTG ou NRTG, para a classificação de proteção, criei uma função separada)
col1 e col2 - cor da linha com um valor acima / abaixo da média.


A maioria dplyr funções dplyr usa avaliação não padrão (NSE ). Este é um termo geral que significa que a avaliação deles difere da avaliação usual em R. Isso nos permite simplificar a escrita de código e trabalhar com bancos de dados SQL, mas o ponto negativo é que não podemos substituir o valor por um objeto equivalente definido em outro lugar.


Dplyr usa avaliação Tidy . Portanto, é necessário usar ferramentas especiais (funções de citação, operador !!) para resolver problemas encontrados durante a programação. Você pode ler mais sobre isso aqui e ver aqui .


O código a seguir pega o nome do argumento da função e grava a expressão que foi apresentada a ele. (Para entender como as enquo e similares funcionam, é útil imprimir a saída dessa função)


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

Em seguida, alteramos o formato dos dados de algumas colunas: tornamos GAME_DATE do caractere uma coluna no formato Data e tornamos as colunas de classificação numéricas. Porque aplicamos a função as.numeric a três colunas e, em seguida, mutate_at usado em vez de mutate . E classificamos tudo em ordem crescente de data.


 ##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) 

E então calculamos a média móvel de 10 partidas da equipe de que precisamos. Para fazer isso, use a função rollmeanr do pacote zoo . r no final do nome significa que o resultado deve estar alinhado à direita. Nos nove primeiros jogos da temporada, é impossível calcular uma média móvel de 10 partidas, portanto, deixamos esses campos inalterados preenchendo-os em NA usando o argumento de preenchimento. na.omit remove da tabela as linhas nas quais esses NA ocorrem.


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

A tabela da equipe fica assim:


TEAM_IDTEAM_ABBREVIATIONTEAM_NAMEGAME_IDGAME_DATEMATCHUPWlORTGDRTGNRTGClassificação
1610612742DALDallas mavericks002180015006/11/2018DAL vs. WasW116,899,217,6105,51
1610612742DALDallas mavericks002180016007/11/2018DAL @ UTAL98,5112,0-13,6104,92
1610612742DALDallas mavericks002180018110/11/2018DAL vs. OkcW115,0101,113,9104,13
1610612742DALDallas mavericks002180019312/11/2018DAL @ CHIW98,391,07.3103,03
1610612742DALDallas mavericks002180021014/11/2018DAL vs. UTAW117,365,851,6105,34

Em princípio, já recebemos as informações de que precisamos. Usando duas linhas de código, você pode criar um gráfico de linhas. Mas a linha preta em um fundo branco é de pouco interesse do ponto de vista estético e informativo. Uma outra parte do "corpo da função" corrige isso.


Para começar, adicionamos os dados no valor da classificação média, 10 e 21 (décimo da parte inferior), bem como a data 10 da partida da equipe (ou seja, a primeira para a qual a média móvel é calculada e que permaneceu na tabela da equipe após excluir as linhas de 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]] 

Das funções não utilizadas anteriormente, a função de slice aparece aqui, que seleciona as linhas pelo número de série.


Em seguida, selecionamos duas cores e seu nome. Os dados, como da última vez, são table_color da tabela table_color . O nome será usado no cabeçalho do gráfico para explicar qual das cores corresponde aos valores abaixo da média e qual é mais alta.


 ##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]] 

Os argumentos da função são padronizados para col1 e col2, essas são a primeira e a segunda cores dos comandos. Na maioria dos casos (mais precisamente em 26), esses valores não precisam ser alterados; no entanto, para quatro equipes, a seguinte cor deve ser usada em sua paleta de cores. Em Dallas e Minnesota, a primeira e a segunda cores são muito semelhantes, enquanto em Milwaukee e Brooklyn não são visíveis em um fundo branco. Tanto isso como outro complicam a leitura do cronograma, portanto, vale a pena usar o argumento col2 = col3 para eles.


Em seguida, obtemos a classificação máxima para a equipe. Precisamos desse valor para organizar o texto com o valor da classificação no gráfico. Quero prestar atenção na última linha do código. Aconteceu que as funções traçaram perfeitamente gráficos em 89 dos 90 casos, mas ao criar uma classificação de proteção, Milwaukee cometeu um erro. Aconteceu que o valor máximo de classificação em Milwaukee é alcançado duas vezes e o ggplot2 naturalmente começa a jurar que a estética deve ser, no nosso caso, 1 ou 73. Portanto, precisamos de um único valor máximo de classificação.


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

Construindo um gráfico estático no 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 & Tools\nTelegram: @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") 

Das novidades aqui, o uso da função if_else para alterar a cor da linha, dependendo se a classificação média da Liga é maior ou menor, bem como a primeira linha que altera o código do idioma. Isso é feito para que as abreviações dos nomes dos meses ao longo do eixo X sejam escritas em inglês.


Animação de uma média móvel de 10 correspondências.


Na construção da animação, adicionei várias loções que não são possíveis na versão estática. Primeiro, a data da mudança (semelhante à forma como o ano mudou no último artigo), bem como o valor da classificação em um determinado momento. Também muda de cor, dependendo de estar acima ou abaixo da média.


 ##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.com\nTelegram: @NBAatlantic, twitter: @vshufinskiy")) 

Resultado



No gráfico, é bastante óbvio que Dallas mergulhou na segunda quinzena de fevereiro a março. A explicação para isso é muito simples: foi nesse ponto da temporada que os Mavericks trocaram 4 dos 5 jogadores nos cinco primeiros, e o principal ativo recebido, o letão Kristaps Porzingis, não jogou por um minuto devido à ruptura dos ligamentos cruzados.


Aqui não vou me aprofundar no componente esportivo; portanto, se alguém estiver interessado em ver os 89 gráficos restantes da temporada 2018-19, seja bem-vindo ao meu blog no sports.ru , onde planejo escrever um artigo com uma visão geral dos mais interessantes deles ou no meu telegrama. canal sobre a NBA, onde eu vou postar todos eles.


Repositório do GitHub

Source: https://habr.com/ru/post/pt459142/


All Articles