Introdução Link para o cabeçalho
Recentemente me deparei com o site data.world e encontrei o conjunto de dados June 2020 - NBA Shots (1997-2019). São dados de todos os 4.729.512 de arremessos feitos na NBA, convertidos ou não, entre 1997 e 2020. Resolvi então criar visualizações espaciais destes arremessos, para ver se surgiria algum padrão interessante.
Preparação Link para o cabeçalho
Como sempre, o primeiro passo em uma análise feita no R é carregar os pacotes e o conjunto de dados a ser analisado.
# pacotes necessarios
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
theme_set(theme_void())
library(lubridate)
# importando os dados
# fonte: https://data.world/sportsvizsunday/june-2020-nba-shots-1997-2019
nba <- read_csv(file = "data/NBAShotLocations19972020.csv")
# limpando os nomes das colunas
nba <- janitor::clean_names(nba)
Com os dados lidos, vou criar uma variável nova chamada season, referente às temporadas da NBA. Como são 23 temporadas no conjunto de dados, eu não quis procurar as datas de início e encerramento de cada uma delas. Mas como sei que nunca ocorrem jogos da NBA em setembro, utilizei essa aproximação grosseira para determinar quais arremessos pertenciam a cada temporada.
# criando a variavel temporada
nba <- nba %>%
mutate(game_date = ymd(game_date))
nba <- nba %>%
mutate(season = case_when(
game_date >= ymd("1997-09-30") & game_date <= ymd("1998-09-01") ~ "1997-98",
game_date >= ymd("1998-09-30") & game_date <= ymd("1999-09-01") ~ "1998-99",
game_date >= ymd("1999-09-30") & game_date <= ymd("2000-09-01") ~ "1999-00",
game_date >= ymd("2000-09-30") & game_date <= ymd("2001-09-01") ~ "2000-01",
game_date >= ymd("2001-09-30") & game_date <= ymd("2002-09-01") ~ "2001-02",
game_date >= ymd("2002-09-30") & game_date <= ymd("2003-09-01") ~ "2002-03",
game_date >= ymd("2003-09-30") & game_date <= ymd("2004-09-01") ~ "2003-04",
game_date >= ymd("2004-09-30") & game_date <= ymd("2005-09-01") ~ "2004-05",
game_date >= ymd("2005-09-30") & game_date <= ymd("2006-09-01") ~ "2005-06",
game_date >= ymd("2006-09-30") & game_date <= ymd("2007-09-01") ~ "2006-07",
game_date >= ymd("2007-09-30") & game_date <= ymd("2008-09-01") ~ "2007-08",
game_date >= ymd("2008-09-30") & game_date <= ymd("2009-09-01") ~ "2008-09",
game_date >= ymd("2009-09-30") & game_date <= ymd("2010-09-01") ~ "2009-10",
game_date >= ymd("2010-09-30") & game_date <= ymd("2011-09-01") ~ "2010-11",
game_date >= ymd("2011-09-30") & game_date <= ymd("2012-09-01") ~ "2011-12",
game_date >= ymd("2012-09-30") & game_date <= ymd("2013-09-01") ~ "2012-13",
game_date >= ymd("2013-09-30") & game_date <= ymd("2014-09-01") ~ "2013-14",
game_date >= ymd("2014-09-30") & game_date <= ymd("2015-09-01") ~ "2014-15",
game_date >= ymd("2015-09-30") & game_date <= ymd("2016-09-01") ~ "2015-16",
game_date >= ymd("2016-09-30") & game_date <= ymd("2017-09-01") ~ "2016-17",
game_date >= ymd("2017-09-30") & game_date <= ymd("2018-09-01") ~ "2017-18",
game_date >= ymd("2018-09-30") & game_date <= ymd("2019-09-01") ~ "2018-19",
game_date >= ymd("2019-09-30") & game_date <= ymd("2020-09-01") ~ "2019-20"
))
Visualização Link para o cabeçalho
Com os dados preparados eu pude começar a minha análise. Em primeiro lugar plotei apenas os locais em que cada arremesso foi realizado. Ou seja, cada ponto a seguir indica apenas se houve ou não um arremesso a partir dele, sem preocupação com a frequência.
# calculando o numero de arremessos por localizacao
nba_tally <- nba %>%
group_by(x_location, y_location) %>%
count()
# plotando de forma discreta
ggplot(nba_tally, aes(x = x_location, y = y_location, fill = n)) +
geom_tile() +
coord_equal() +
theme(legend.position = "none") +
scale_fill_viridis_c()
O segundo passo foi criar uma versão do gráfico anterioe como mapa de calor. Quanto mais clara a cor, mais frequente é o local do arremesso. Para que essa visualização ficasse interessante, eu retirei três outliers dos dados, de modo que eles não se sobrepujassem aos demais.
# mapa de calor
nba_tally <- nba_tally %>%
arrange(desc(n))
head(nba_tally)
## # A tibble: 6 × 3
## # Groups: x_location, y_location [6]
## x_location y_location n
## <dbl> <dbl> <int>
## 1 0 0 633328
## 2 0 1 33759
## 3 0 -6 17392
## 4 1 1 5687
## 5 0 3 2965
## 6 0 7 2840
# retirando os tres outliers
nba_tally <- tail(nba_tally, -3)
# mapa de calor
ggplot(nba_tally, aes(x = x_location, y = y_location, fill = log(n))) +
geom_tile() +
coord_equal() +
theme(legend.position = "none") +
scale_fill_viridis_c()
Por fim, criei mapas de calor para cada temporada. Novamente, eu retirei outliers dos dados. Nesse caso, foram todos os arremessos imediatamente abaixo da cesta, para todas as temporadas.
# mapa de calor por temporada
nba_tally_season <- nba %>%
group_by(x_location, y_location, season) %>%
count()
nba_tally_season %>%
group_by(season) %>%
top_n(n = 5) %>%
arrange(desc(n)) %>%
print(n = Inf)
## Selecting by n
## # A tibble: 117 × 4
## # Groups: season [23]
## x_location y_location season n
## <dbl> <dbl> <chr> <int>
## 1 0 0 2007-08 53562
## 2 0 0 2008-09 53122
## 3 0 0 2009-10 52631
## 4 0 0 2006-07 52337
## 5 0 0 2004-05 52008
## 6 0 0 2005-06 51992
## 7 0 0 1997-98 51828
## 8 0 0 2003-04 49967
## 9 0 0 2002-03 49097
## 10 0 0 2001-02 48970
## 11 0 0 1999-00 45614
## 12 0 0 2000-01 43814
## 13 0 0 1998-99 28153
## 14 0 1 2016-17 10892
## 15 0 1 2014-15 10419
## 16 0 1 2015-16 10374
## 17 0 -6 2018-19 6335
## 18 0 -6 2017-18 5728
## 19 0 -6 2019-20 4664
## 20 1 1 2012-13 902
## 21 1 1 2013-14 891
## 22 1 1 2010-11 755
## 23 1 1 2011-12 683
## 24 1 1 2014-15 594
## 25 9 7 2016-17 501
## 26 0 6 2012-13 477
## 27 9 7 2015-16 467
## 28 0 3 2012-13 458
## 29 9 2 2016-17 426
## 30 9 2 2015-16 425
## 31 9 11 2016-17 420
## 32 9 11 2015-16 419
## 33 0 3 2013-14 405
## 34 0 1 2012-13 404
## 35 0 3 2010-11 404
## 36 0 1 2013-14 402
## 37 0 4 2010-11 390
## 38 0 6 2010-11 384
## 39 0 3 2011-12 371
## 40 0 4 2013-14 371
## 41 0 1 2010-11 360
## 42 0 4 2012-13 360
## 43 0 1 2011-12 354
## 44 -2 0 2013-14 349
## 45 0 4 2011-12 346
## 46 0 7 2011-12 326
## 47 3 0 2000-01 304
## 48 0 4 2014-15 297
## 49 15 2 2015-16 297
## 50 0 6 2014-15 295
## 51 4 7 2016-17 293
## 52 -1 4 2001-02 290
## 53 -1 9 2001-02 280
## 54 0 7 2014-15 275
## 55 3 4 2001-02 264
## 56 3 4 2000-01 263
## 57 -1 0 2000-01 262
## 58 -1 4 2000-01 256
## 59 -1 -3 1999-00 220
## 60 -1 0 2001-02 219
## 61 1 1 2008-09 207
## 62 0 8 2017-18 188
## 63 -2 11 2018-19 187
## 64 0 10 2018-19 186
## 65 0 13 2018-19 183
## 66 1 1 2009-10 182
## 67 1 5 1999-00 181
## 68 2 10 2017-18 180
## 69 3 8 2017-18 178
## 70 1 1 2007-08 175
## 71 -2 8 2017-18 174
## 72 0 8 2018-19 167
## 73 5 5 1999-00 159
## 74 1 1 2006-07 154
## 75 12 3 1998-99 151
## 76 1 -3 1999-00 149
## 77 2 10 2019-20 149
## 78 1 1 1997-98 145
## 79 1 1 2005-06 140
## 80 3 3 1998-99 140
## 81 0 5 2019-20 133
## 82 0 10 2019-20 132
## 83 0 11 2019-20 131
## 84 1 1 2004-05 123
## 85 1 5 1998-99 119
## 86 1 1 2002-03 117
## 87 12 8 1998-99 114
## 88 0 1 2009-10 112
## 89 0 6 2009-10 108
## 90 1 1 2003-04 101
## 91 0 6 2008-09 98
## 92 0 3 2008-09 96
## 93 0 3 2009-10 96
## 94 0 2 2007-08 90
## 95 -1 0 1997-98 89
## 96 1 0 2007-08 89
## 97 0 5 2007-08 87
## 98 1 0 2006-07 87
## 99 -2 0 2006-07 84
## 100 3 3 1997-98 83
## 101 5 0 2006-07 82
## 102 -1 3 1997-98 81
## 103 -2 0 2008-09 80
## 104 -5 0 2004-05 79
## 105 0 2 2004-05 79
## 106 0 5 2005-06 78
## 107 0 7 2005-06 76
## 108 0 2 2005-06 74
## 109 1 0 2005-06 74
## 110 1 0 2002-03 73
## 111 0 3 2002-03 72
## 112 0 5 2002-03 72
## 113 0 8 2004-05 72
## 114 -6 0 2003-04 56
## 115 -5 0 2003-04 52
## 116 5 0 2003-04 51
## 117 11 0 2003-04 51
Como eu gostaria que o gráfico ficasse esteticamente agradável, retirei as duas temporadas mais antigas e a mais recente, que ainda não está completa. Assim, fiquei com as 20 temporadas que se ajustaram perfeitamente em um grid 5x4:
# retirar as duas primeiras e a ultima temporada
'%ni%' <- Negate('%in%')
nba_tally_season <- nba_tally_season %>%
filter(!(x_location == 0 && y_location == 0)) %>%
filter(season %ni% c("1997-98", "1998-99", "2019-20")) %>%
group_by(season) %>%
mutate(n_normalized = n/max(n))
ggplot(nba_tally_season, aes(x = x_location, y = y_location, fill = log(1000*n_normalized))) +
geom_tile() +
coord_equal() +
theme(legend.position = "none") +
facet_wrap(~ season) +
scale_fill_viridis_c() +
theme(strip.background = element_rect(fill = "grey"),
panel.spacing = unit(0, "lines"),
panel.border = element_rect(colour = "black", fill = NA, size = 0.5))
E então? O que achou dessas visualizações? Há muitas outras a serem feitas. Por exemplo, comparar o estilo de arremessos dos times campeões. Como o Lakers campeão com Shaquille O’Neal e Kobe Bryant se compara ao Golden State Warriors de Curry e companhia? Faça as suas visualizações e passe aqui para compartilhá-las.
O código completo desta análise (menos os dados) está disponível em meu github.