Data Visualization Exercise - WNBA GOAT

About My Figure

This is the image I’m trying to replicate. I found this in an article at FiveThirtyEight that describes Cynthia Cooper-Dykes’s domination of the court in the 1990-2000s. She played on the Houston Comets and led them to being one of the best WNBA teams every by composite ratings. However, an employee at FiveThirtyEight created their own measure for team performance called Elo. The ratings change after every game based on the winner’s pregame win probability, with more unexpected wins resulting in more points shifting from the loser’s rating to the winner’s. The author used this system to support their argument for the Houston Comets’ domination, attributed to Cooper-Dyke.

The datasetsupplied has four different Elo ratings for each game played between 1997 and 2019 season. Two scores are the away team and two are the home team. Likewise, two are their respective rankings before the game while the other two are the respective rankings after the game.

The graph nor the article describe if the pre- or post-Elo score is used. However, it can be assumed that one game’s pre-score is the previous game’s post score, so I will use the post score to track Elo rankings over time.

Read in the Data

elo<-read_csv("C:/users/abbie/Desktop/MADA2023/WNBA-stats/wnba-team-elo-ratings.csv")

Rows: 10488 Columns: 16
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (5): date, team1, team2, name1, name2
dbl (11): season, neutral, playoff, score1, score2, elo1_pre, elo2_pre, elo1...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

glimpse(elo)

Rows: 10,488
Columns: 16
$ season    <dbl> 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, …
$ date      <chr> "10/10/2019", "10/10/2019", "10/8/2019", "10/8/2019", "10/6/…
$ team1     <chr> "WAS", "CON", "WAS", "CON", "WAS", "CON", "WAS", "CON", "WAS…
$ team2     <chr> "CON", "WAS", "CON", "WAS", "CON", "WAS", "CON", "WAS", "CON…
$ name1     <chr> "Washington Mystics", "Connecticut Sun", "Washington Mystics…
$ name2     <chr> "Connecticut Sun", "Washington Mystics", "Connecticut Sun", …
$ neutral   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ playoff   <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
$ score1    <dbl> 89, 78, 86, 90, 94, 81, 87, 99, 95, 86, 94, 90, 75, 78, 92, …
$ score2    <dbl> 78, 89, 90, 86, 81, 94, 99, 87, 86, 95, 90, 94, 92, 56, 75, …
$ elo1_pre  <dbl> 1684, 1634, 1693, 1626, 1671, 1648, 1700, 1618, 1694, 1624, …
$ elo2_pre  <dbl> 1634, 1684, 1626, 1693, 1648, 1671, 1618, 1700, 1624, 1694, …
$ elo1_post <dbl> 1692, 1627, 1684, 1634, 1693, 1626, 1671, 1648, 1700, 1618, …
$ elo2_post <dbl> 1627, 1692, 1634, 1684, 1626, 1693, 1648, 1671, 1618, 1700, …
$ prob1     <dbl> 0.718, 0.282, 0.476, 0.524, 0.399, 0.601, 0.763, 0.237, 0.74…
$ is_home1  <dbl> 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1, 0, 0, …

#get date to date form
elo$date<-anydate(elo$date) #different length character strings weren't compatable with lubridate 

#filter for HOU
elo_hou_raw<-elo%>%
  filter(team1 == "HOU" | team2 == "HOU",
         !duplicated(date),
         date < "2001-01-01")%>%            #Sometimes there's a duplicate entry for the same game where the only difference is team1 and team2 are switched
  arrange(date)%>%
  mutate(game = row_number())             #Count the game number since that is the x axis for the graph
glimpse(elo_hou_raw)

Rows: 138
Columns: 17
$ season    <dbl> 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, …
$ date      <date> 1997-06-21, 1997-06-24, 1997-06-26, 1997-06-28, 1997-06-30,…
$ team1     <chr> "HOU", "HOU", "NYL", "HOU", "HOU", "NYL", "NYL", "PHO", "HOU…
$ team2     <chr> "CLE", "PHO", "HOU", "LVA", "LAS", "HOU", "HOU", "HOU", "SAC…
$ name1     <chr> "Houston Comets", "Houston Comets", "New York Liberty", "Hou…
$ name2     <chr> "Cleveland Rockers", "Phoenix Mercury", "Houston Comets", "U…
$ neutral   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ playoff   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ score1    <dbl> 76, 72, 62, 76, 71, 72, 65, 69, 89, 82, 77, 86, 64, 81, 63, …
$ score2    <dbl> 56, 55, 60, 58, 66, 67, 58, 64, 61, 60, 69, 76, 73, 57, 74, …
$ elo1_pre  <dbl> 1500, 1530, 1539, 1535, 1558, 1556, 1564, 1554, 1547, 1542, …
$ elo2_pre  <dbl> 1500, 1515, 1544, 1479, 1498, 1564, 1556, 1554, 1485, 1466, …
$ elo1_post <dbl> 1530, 1544, 1548, 1558, 1564, 1564, 1579, 1561, 1563, 1567, …
$ elo2_post <dbl> 1470, 1501, 1535, 1456, 1492, 1556, 1541, 1547, 1469, 1441, …
$ prob1     <dbl> 0.387, 0.634, 0.381, 0.466, 0.692, 0.603, 0.397, 0.614, 0.69…
$ is_home1  <dbl> 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, …
$ game      <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 1…

Now we need to separate and rejoin the dataframes based on if HOU is team1 or team2 so we have a cohesive HOU dataframe regardless of home or away status.

#Separate
hou1<-elo_hou_raw%>%
  filter(team1 == "HOU")%>%
  select(season, date, team1, name1, elo1_post, game)%>%
  rename(team = team1, name=name1, elo_post = elo1_post)

hou2<-elo_hou_raw%>%
  filter(team2 == "HOU")%>%
  select(season, date, team2, name2, elo2_post, game)%>%
  rename(team = team2, name=name2, elo_post = elo2_post)

#Rejoin
elo_hou_clean<-rbind(hou1, hou2)

Making the Plots

ggplot()+
  geom_line(aes(x=game, y=elo_post), data=elo_hou_clean, color = "red", linewidth =1)+
  theme(axis.title.y = element_blank(), 
        axis.text.y = element_text(color = "gray30", family =  "mono", size = 12), 
        axis.text.x = element_text(color = "gray30", family =  "mono", size = 12), 
        plot.title = element_text(face = "bold", hjust = -.15, size = 15), 
        plot.subtitle = element_text(hjust = -.15, size = 12),
        axis.title.x = element_text(face="bold", family = "sans"),
        axis.line.y = element_line(colour = "black", linewidth=.5, linetype = "solid"),
        axis.line.x = element_line(colour = "gray80",linewidth=.5, linetype = "solid"), 
        plot.background = element_rect(fill = 'gray95'), panel.background = element_rect(fill = 'gray95'),
        panel.grid.major = element_line("gray80"),
        panel.grid.minor = element_blank())+
  labs(title = "How Houston became the best WNBA team ever", subtitle = "Game-by-game Elo rating for the Houston Comets, 1997-2000")+
  scale_x_continuous(name="Game Number", breaks = seq(0, 140, 20))+
  scale_y_continuous(breaks = seq(1500, 1800, 100), limits = c(1500, 1830))

Throughout this process, the biggest trouble I had was finding the correct fonts to match those of the articles. I referenced the R Cookbook a good bit during this step. I tried several fonts but could not find the exact one used by the authors - it may have been uploaded independently of the pre-loaded options. Mine are not off by a lot, but enough to notice. This exercise also allowed me to experiment more with the theme function and the different elements of the graph. In the past I have used many of these individually, but very rarely nearly all of the options. It makes my code seem a bit overwhelming, but the functionality is super nice!