NBA Draft Odds Plot

Reproduce an NBA draft odds stacked bar plot

Original Source

I was scrolling twitter and noticed this tweet from David Sparks - Director of Basketball Analytics for the Boston Celtics:

With his obligatory shoutouts to Hadley Wickham and BoB Rudis, I felt compelled to reproduce the plot in RStudio and get some ggplot2 code out there open-sourcing his work.

Package Dependencies and Data

The data was generated using simulations of the NBA Draft lottery, which resulted in some peculiar distributions compared to the raw lottery odds. I fudged some of the data based on how it looked in the plot - not much I can do about that since there wasn’t anything programmatically to work from there! ¯\_(ツ)_/¯

#devtools::install_github("hadley/ggplot2")
#devtools::install_github("hadley/tidyr")
library(ggplot2)
library(tidyr)
library(RCurl)
library(RColorBrewer)
dataurl <- 'https://gist.githubusercontent.com/mikeleeco/268429d0b4019ec30c4e547c16d7f766/raw/afa955af265d14a2f72780e4e0b87ffe469c0109/odds.csv'
data <- getURL(dataurl)
odds <- read.csv(textConnection(data))

Data Cleanup

The tidyr package allows us to reshape our data between long and wide formats, RColorBrewer helps generate a fluid color pallete for our plot, and RCurl assists in sourcing the data from my gist.

odds <- gather(odds, X)
odds[,2] <- substring(odds[,2], 2)
colnames(odds) <- c("Team","Pick","Probability")
odds$Pick <- as.numeric(odds$Pick)
odds$Team <- as.character(odds$Team)
odds$Team <- factor(odds$Team, levels = odds[1:14,1])
odds$Team <- factor(odds$Team, levels=rev(levels(odds$Team)))
odds$Pick <- factor(odds$Pick, levels = 1:14)
getPalette <- colorRampPalette(brewer.pal(11, "Spectral"))(14)
odds$Probability <- ifelse(is.na(odds$Probability),0,odds$Probability)

The colorRampPallete and brewer.pal functions expands the “Spectral” color pallete from 11 to 14 colors, and we’ve organized our Team y-axis to be leveled in order of likelihood of winning the top pick - without factoring in the projections that were used in the @celtics figure.

The Custom Plot Theme

Now that we’ve prepared our data, we can get to customizing the plot!

g <- ggplot(odds, aes(Team))
g <- g + geom_bar(aes(x = Team, y = Probability, fill = Pick),alpha=0.9,stat="identity")
g <- g + scale_y_continuous(breaks = seq(0, 1, by = 0.1),1,name="Probability", labels=scales::percent) +
    labs(x=NULL, y=NULL, title="2016 NBA Draft Lottery Probabilities",
         subtitle = "After tiebreakers and trades. Trades with protections are indicated by a black border, and the receiving team is named. Based on 100,000 simulations",
         caption="Reproduced by: @mikeleeco                  Original: @dsparks                  Source: http://www.nba.com/celtics/news/sidebar/2016-draft-lottery-qa") +
    coord_flip() +
    scale_fill_manual(values = getPalette)

The development version of ggplot2 on github features numerous additions including ecpanded arguments for labs such as subtitles and captions. Check out ?ggplot2::labs or Bob Rudis’ post on his contribution to ggplot2.

g <- g  + theme(
  axis.text.x = element_text(size=14,margin=margin(b=5),color = "black"),
  axis.title.x = element_text(size=16),
  plot.subtitle = element_text(size=14),
  plot.caption = element_text(size=16,margin = margin(t=20),face = "italic", hjust = .5),
  axis.text.y = element_text(size=18,margin = margin(r=-40),colour = "black"),
  axis.ticks.y=element_blank(),
  axis.ticks.x=element_blank(),
  plot.title = element_text(size=30,margin = margin(b=10)),
  panel.border=element_blank(),
  panel.grid.major.x=element_line(color="#2b2b2b", linetype="dotted", size=0.15),
  panel.grid.major.y=element_blank(),
  legend.text = element_text(size=14),
  legend.title = element_text(size=18),
  legend.key = element_rect(fill="#DCDCDC",colour = "#DCDCDC"),
  legend.background = element_rect(fill="#DCDCDC"),
  panel.background = element_rect(fill="#DCDCDC"),
  plot.background = element_rect(fill="#DCDCDC")
)

As seen in the theme here, the developtmental version of ggplot2 also features elements to customize the new caption and subtitle arguments. Things are looking pretty sharp!

Annotations - Call for Help!

The lottery data has been transformed into a customized plot; the only missing pieces are the transparent rectangular grobs indicating picks with trade implications. I tried a few different methods to programmatically assign labels over the rows in our dataset, none of which gave the desired final output. Instead I used brute force to place transparent rectangles and texts over the appropriate data blocks:

g <- g + annotate("text", x = (13.45+12.55)/2, y = .6, alpha = 1,color="black", label="to PHI", size= rel(7)) +
            annotate("rect", xmin = 12.55, xmax = 13.45, ymin = .555, ymax = 1, alpha = .3,color="black") +
            annotate("text", x = (2.45+1.55)/2, y = .1, alpha = 1,color="black", label="to PHX", size= rel(7)) +
            annotate("rect", xmin = 1.55, xmax = 2.45, ymin = .021, ymax = 1, alpha = .3,color="black") +
            annotate("text", x = (7.45+6.55)/2, y = .95, alpha = 1,color="black", label="to CHI >", size= rel(7)) +
            annotate("rect", xmin = 6.55, xmax = 7.45, ymin = .999, ymax = 1, alpha = .3,color="black")

There has to be a more efficient method to do this! If you know of a better way please contact me on twitter or create a pull request on this post.

Final product:

draft_odds
← Back to all posts