Pokémon x NBA team medians, and other fun with ggimage
Mara Averick
2017-04-13
library(stattleshipR)
library(dtplyr)
library(tidyverse)Note that for ggimage you’ll have to include BioC repo for dependencies, and, if using devtools, setRepositories(ind=1:2).
## for pokemon: ggimage
library(ggimage)
## for theme options: devtools::install_github("hrbrmstr/hrbrthemes")
library(hrbrthemes)The summary statistics are for each of the NBA teams during the 2016-17 regular season, through 2017-04-12 acquired through stattleshipR, the R wrapper for the Stattleship API.
Team vs Opponent Avg Points by Type
Use ggrepel for better formatting of text labels.
## install.packages("ggrepel")
library(ggrepel)
## median total points
med_total_points_plot <- ggplot(median_pt_tgls, aes(team_score, opponent_score)) +
geom_vline(xintercept = median(median_pt_tgls$team_score), linetype = "dashed") +
geom_hline(yintercept = median(median_pt_tgls$opponent_score), linetype = "dashed") +
geom_point(shape = 1) +
geom_label_repel(aes(fill= median_pt_tgls$team_slug, label = median_pt_tgls$team_lab, fontface = 'bold', colour = median_pt_tgls$team_slug)) +
scale_fill_manual(values = nbaCols) +
scale_color_manual(values = nbaText) +
labs(x = "points scored", y = "points allowed") +
ggtitle("Median Team Points Scored & Allowed") +
theme_bw() +
theme(legend.position = "none") +
theme(plot.title = element_text(family="Trebuchet MS", face="bold", size=20, hjust=0, color="#555555"))
## show plot
med_total_points_plot
Now with Pokémon
In ggimage, a fun little package by Guangchuang YU, you can map and use images in the gggplot2 graphic system. It comes with a few already-defined geometries, including geom_pokemon(), which inspired this whole endeavor.
Because I don’t actually know the Pokemon (sorry), I’ve matched each team to its NBAmixes.com NBA Logos X Pokémon mashups counterpart as re-imagined by artist Micah Coles to the best of my ability. Sometimes the pokelogos weren’t of an actual Pokémon creature thing (sorry, I’m trying) or were of a Pokémon that didn’t have an image counterpart in the package, in which case, I just kind of guessed. You can see the team logos in their full-sized glory in Micah’s Pokémon NBA imgur gallery (plus, a couple “throwback” extras– e.g. Onix Sonics).
NBA Teams using 1st generation Pokemon by Micah Coles
To make things a bit more visually palatable, I’m also going to use one of Bob Rudis’ “opinionated, typographic-centric ggplot2 themes” from the hrbrthemes package.
poke_summary_tgls %>%
ggplot( aes(team_score, opponent_score)) +
geom_vline(xintercept = median(poke_summary_tgls$team_score), linetype = "dashed") +
geom_hline(yintercept = median(poke_summary_tgls$opponent_score), linetype = "dashed") +
geom_pokemon(data = poke_summary_tgls, aes(image = poke_summary_tgls$poke)) +
labs(x = "points scored", y = "points allowed", title="Median NBA Team Points Scored & Allowed", subtitle="NBA logos X Pokémon X ggimage X hrbrthemes", caption = "NBA Logos X Pokémon mash-ups by NBAmixes.com, data source: stattleship") +
theme_ipsum_rc()
Geometries of our own?
We could use any geometry we like, really. And, given the fact that the Pokémon matches are a little vague, we might try for something that actually makes some semantic sense. Let’s try using some super-cool-looking Minimalist NBA Logos made by Matt Miro.
Minimalized logo/icon work for every NBA team by Matt Miro
geom_minnba <- function(mapping=NULL, data=NULL, inherit.aes=TRUE,
na.rm=FALSE, by="width", ...) {
geom_image(mapping, data, inherit.aes=inherit.aes, na.rm=na.rm, ..., geom = 'minnba')
}poke_summary_tgls %>%
ggplot( aes(team_score, opponent_score)) +
geom_vline(xintercept = median(poke_summary_tgls$team_score), linetype = "dashed") +
geom_hline(yintercept = median(poke_summary_tgls$opponent_score), linetype = "dashed") +
geom_minnba(data = poke_summary_tgls, aes(image = poke_summary_tgls$minnba_img)) +
labs(x = "points scored", y = "points allowed", title="Median NBA Team Points Scored & Allowed", subtitle="Minimalist NBA Logos by Matt Miro", caption = "logo source: https://www.behance.net/gallery/37739593/Minimalist-NBA-Logos") +
theme_ipsum_rc()
poke_summary_tgls %>%
ggplot( aes(points_in_paint, opp_points_in_paint)) +
geom_vline(xintercept = median(poke_summary_tgls$points_in_paint), linetype = "dashed") +
geom_hline(yintercept = median(poke_summary_tgls$opp_points_in_paint), linetype = "dashed") +
geom_pokemon(data = poke_summary_tgls, aes(image = poke_summary_tgls$poke)) +
labs(x = "points scored", y = "points allowed", title="Median Points in Paint", subtitle="NBA teams x Pokémon, per game") +
theme_ipsum_rc()
Possession-Adjusted Averages
## possessions
poke_poss_tgls %>%
ggplot(aes(POSS, team_score)) +
geom_vline(xintercept = median(poke_poss_tgls$POSS), linetype = "dashed") +
geom_hline(yintercept = median(poke_poss_tgls$team_score), linetype = "dashed") +
geom_pokemon(data = poke_poss_tgls, aes(image = poke_poss_tgls$poke)) +
labs(x = "possessions", y = "points", title="Median Possessions vs. Points Per Game", subtitle="NBA teams x Pokémon") +
theme_ipsum_rc()
## mean possessions
mean_poss_pt_tgls %>%
ggplot(aes(POSS, team_score)) +
geom_vline(xintercept = mean(mean_poss_pt_tgls$POSS), linetype = "dashed") +
geom_hline(yintercept = mean(mean_poss_pt_tgls$team_score), linetype = "dashed") +
geom_minnba(data = mean_poss_pt_tgls, aes(image = mean_poss_pt_tgls$minnba_img)) +
labs(x = "possessions", y = "points", title="Mean Possessions vs. Points Per Game", subtitle="Minimalist NBA Logos by Matt Miro", caption = "logo source: https://www.behance.net/gallery/37739593/Minimalist-NBA-Logos") +
theme_ipsum_rc()
## points per 100 poss
poke_poss_tgls %>%
ggplot(aes(pts_p100poss, opp_pts_p100poss)) +
geom_vline(xintercept = median(poke_poss_tgls$pts_p100poss), linetype = "dashed") +
geom_hline(yintercept = median(poke_poss_tgls$opp_pts_p100poss), linetype = "dashed") +
geom_pokemon(data = poke_poss_tgls, aes(image = poke_poss_tgls$poke)) +
labs(x = "points scored", y = "points allowed", title="Median Points Scored & Allowed Per 100 Poss", subtitle="NBA teams x Pokémon, per 100 possessions") +
theme_ipsum_rc()
Let’s try another geom
Artist Robb Harskamp did a series of illustrations for Hooped Up NBA team jerseys that:
combin[ed] all 30 team jerseys with advertising from some of the largest corporate entities in the same city or state as the team.
Since we’re using ggimage, we can just use a path to the images (which I shrunk down from their original size) to use the jerseys as “shapes” for our plot by defining a function for the new geometry.
Minimalist NBA Jerseys x Forbes List by Robb Harskamp
geom_jersey <- function(mapping=NULL, data=NULL, inherit.aes=TRUE,
na.rm=FALSE, by="width", ...) {
geom_image(mapping, data, inherit.aes=inherit.aes, na.rm=na.rm, ..., geom = 'jersey')
}mean_poss_pt_tgls %>%
ggplot(aes(pts_p100poss, opp_pts_p100poss)) +
geom_vline(xintercept = mean(mean_poss_pt_tgls$pts_p100poss), linetype = "dashed") +
geom_hline(yintercept = mean(mean_poss_pt_tgls$opp_pts_p100poss), linetype = "dashed") +
geom_jersey(data = mean_poss_pt_tgls, aes(image = mean_poss_pt_tgls$jersey)) +
labs(x = "points scored", y = "points allowed", title="Mean Points Scored & Allowed Per 100 Poss", subtitle="Minimalist NBA Jerseys x Forbes List by Robb Harskamp", caption = "logo source: http://hoopeduponline.com/2016/04/20/minimalist-nba-jerseys-x-forbes-list-illustrated/") +
theme_ipsum_rc()
## points in paint per 100
poke_poss_tgls %>%
ggplot(aes(paint_p100poss, opp_paint_p100poss)) +
geom_vline(xintercept = median(poke_poss_tgls$paint_p100poss), linetype = "dashed") +
geom_hline(yintercept = median(poke_poss_tgls$opp_paint_p100poss), linetype = "dashed") +
geom_pokemon(data = poke_poss_tgls, aes(image = poke_poss_tgls$poke)) +
labs(x = "points scored", y = "points allowed", title = "Median Points in Paint Per 100 Poss", subtitle = "NBA logos X Pokémon X ggimage X hrbrthemes", caption = "NBA Logos X Pokémon mash-ups by NBAmixes.com, data source: stattleship") +
theme_ipsum_rc()
mean_poss_pt_tgls %>%
ggplot(aes(paint_p100poss, opp_paint_p100poss)) +
geom_vline(xintercept = mean(mean_poss_pt_tgls$paint_p100poss), linetype = "dashed") +
geom_hline(yintercept = mean(mean_poss_pt_tgls$opp_paint_p100poss), linetype = "dashed") +
geom_minnba(data = mean_poss_pt_tgls, aes(image = mean_poss_pt_tgls$minnba_img)) +
labs(x = "points scored", y = "points allowed", title="Mean Points in Paint Per 100 Poss", subtitle="Minimalist NBA Logos by Matt Miro", caption = "logo source: https://www.behance.net/gallery/37739593/Minimalist-NBA-Logos") +
theme_ipsum_rc()
## points off TOs per 100
poke_poss_tgls %>%
ggplot(aes(pts_off_to_per100, opp_topts_p100poss)) +
geom_vline(xintercept = median(poke_poss_tgls$pts_off_to_per100), linetype = "dashed") +
geom_hline(yintercept = median(poke_poss_tgls$opp_topts_p100poss), linetype = "dashed") +
geom_pokemon(data = poke_poss_tgls, aes(image = poke_poss_tgls$poke)) +
labs(x = "points scored", y = "points allowed", title = "Median Points off Turnovers Per 100 Poss", subtitle="NBA teams x Pokémon, per 100 possessions") +
theme_ipsum_rc()
Regular NBA logos?
Why not? In reality, there are many reasons not to use anything of the sort as far as visualization best practices go. However, we might as well go for it, since we’ve gone this far down the rabbit hole…
geom_logos <- function(mapping=NULL, data=NULL, inherit.aes=TRUE,
na.rm=FALSE, by="width", ...) {
geom_image(mapping, data, inherit.aes=inherit.aes, na.rm=na.rm, ..., geom = 'logos')
}mean_poss_pt_tgls %>%
ggplot(aes(pts_off_to_per100, opp_topts_p100poss)) +
geom_vline(xintercept = mean(mean_poss_pt_tgls$pts_off_to_per100), linetype = "dashed") +
geom_hline(yintercept = mean(mean_poss_pt_tgls$opp_topts_p100poss), linetype = "dashed") +
geom_logos(data = mean_poss_pt_tgls, aes(image = mean_poss_pt_tgls$logos)) +
labs(x = "points scored", y = "points allowed", title="Mean Points off Turnovers Per 100 Poss", subtitle="NBA team logos") +
theme_ipsum_rc()
## fast break points per 100
poke_poss_tgls %>%
ggplot(aes(fbpts_p100poss, opp_fbpts_p100poss)) +
geom_vline(xintercept = median(poke_poss_tgls$fbpts_p100poss), linetype = "dashed") +
geom_hline(yintercept = median(poke_poss_tgls$opp_fbpts_p100poss), linetype = "dashed") +
geom_pokemon(data = poke_poss_tgls, aes(image = poke_poss_tgls$poke)) +
labs(x = "points scored", y = "points allowed", title = "Median Fast Break Points Per 100 Poss", subtitle="NBA teams x Pokémon, per 100 possessions") +
theme_ipsum_rc()
Superhero mashups?
These were tricky for me to figure out! I might actually be wrong about some of them, but they’re just so cool-looking…
NBA x Superhero Mashup
The illustrations are from another Hooped Up piece, NBA Logos x Superheroes Mashup, done by artist(s) at N Design.
geom_super <- function(mapping=NULL, data=NULL, inherit.aes=TRUE,
na.rm=FALSE, by="width", ...) {
geom_image(mapping, data, inherit.aes=inherit.aes, na.rm=na.rm, ..., geom = 'super')
}mean_poss_pt_tgls %>%
ggplot(aes(fbpts_p100poss, opp_fbpts_p100poss)) +
geom_vline(xintercept = mean(mean_poss_pt_tgls$fbpts_p100poss), linetype = "dashed") +
geom_hline(yintercept = mean(mean_poss_pt_tgls$opp_fbpts_p100poss), linetype = "dashed") +
geom_super(data = mean_poss_pt_tgls, aes(image = mean_poss_pt_tgls$super)) +
labs(x = "points scored", y = "points allowed", title="Mean Fast Break Points Per 100 Poss", subtitle="NBA Logos x Superheroes Mashup", caption="by N Design via <http://hoopeduponline.com/2017/03/06/nba-logos-x-superheroes-mashup/>") +
theme_ipsum_rc()
## second chance points per 100
poke_poss_tgls %>%
ggplot(aes(scpts_p100poss, opp_scpts_p100poss)) +
geom_vline(xintercept = median(poke_poss_tgls$scpts_p100poss), linetype = "dashed") +
geom_hline(yintercept = median(poke_poss_tgls$opp_scpts_p100poss), linetype = "dashed") +
geom_pokemon(data = poke_poss_tgls, aes(image = poke_poss_tgls$poke)) +
labs(x = "points scored", y = "points allowed", title = "Median Second Chance Points Per 100 Poss", subtitle="NBA teams x Pokémon, per 100 possessions") +
theme_ipsum_rc()
mean_poss_pt_tgls %>%
ggplot(aes(scpts_p100poss, opp_scpts_p100poss)) +
geom_vline(xintercept = mean(mean_poss_pt_tgls$scpts_p100poss), linetype = "dashed") +
geom_hline(yintercept = mean(mean_poss_pt_tgls$opp_scpts_p100poss), linetype = "dashed") +
geom_minnba(data = mean_poss_pt_tgls, aes(image = mean_poss_pt_tgls$minnba_img)) +
labs(x = "points scored", y = "points allowed", title="Mean Second Chance Points Per 100 Poss", subtitle="Minimalist NBA Logos by Matt Miro", caption = "logo source: https://www.behance.net/gallery/37739593/Minimalist-NBA-Logos") +
theme_ipsum_rc()
sessionInfo()## R version 3.3.3 (2017-03-06)
## Platform: x86_64-apple-darwin13.4.0 (64-bit)
## Running under: macOS Sierra 10.12.4
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] ggrepel_0.6.9 bindrcpp_0.1 RColorBrewer_1.1-2
## [4] hrbrthemes_0.2.0 ggimage_0.0.4 dplyr_0.5.0.9001
## [7] purrr_0.2.2.9000 readr_1.1.0 tidyr_0.6.1
## [10] tibble_1.3.0 ggplot2_2.2.1.9000 tidyverse_1.1.1
## [13] dtplyr_0.0.1.9000 stattleshipR_0.0.5 data.table_1.10.4
## [16] httr_1.2.1.9000 jsonlite_1.4 lubridate_1.6.0.9009
##
## loaded via a namespace (and not attached):
## [1] locfit_1.5-9.1 reshape2_1.4.2 haven_1.0.0
## [4] lattice_0.20-35 colorspace_1.3-2 htmltools_0.3.5
## [7] yaml_2.1.14 gridGraphics_0.1-5 rlang_0.0.0.9014
## [10] foreign_0.8-67 glue_0.0.0.9000 EBImage_4.16.0
## [13] BiocGenerics_0.20.0 modelr_0.1.0 readxl_0.1.1
## [16] bindr_0.1 jpeg_0.1-8 plyr_1.8.4
## [19] stringr_1.2.0 munsell_0.4.3 gtable_0.2.0
## [22] rvest_0.3.2.9000 psych_1.7.3.21 evaluate_0.10
## [25] labeling_0.3 knitr_1.15.19 forcats_0.2.0
## [28] extrafont_0.17 parallel_3.3.3 Rttf2pt1_1.3.4
## [31] broom_0.4.2 Rcpp_0.12.10 scales_0.4.1
## [34] backports_1.0.5 abind_1.4-5 mnormt_1.5-5
## [37] hms_0.3 png_0.1-7 digest_0.6.12
## [40] stringi_1.1.5 tiff_0.1-5 grid_3.3.3
## [43] rprojroot_1.2 tools_3.3.3 magrittr_1.5
## [46] lazyeval_0.2.0.9000 pkgconfig_2.0.1 extrafontdb_1.0
## [49] xml2_1.1.1 assertthat_0.2.0 rmarkdown_1.4.0.9001
## [52] R6_2.2.0 fftwtools_0.9-8 nlme_3.1-131