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.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── 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.