Code for: https://rpubs.com/maraaverick/nba-allstar-2019-gt

nba_allstar_gt.Rmd

---
title: "NBA All Stars: further adventures with `gt`"
author: "Mara Averick"
date: '`r Sys.Date()`'
output: 
  html_document:
    keep_md: TRUE
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r message = FALSE, warning = FALSE}
library(tidyverse)
library(lubridate, warn.conflicts = FALSE)
library(gt)
```

```{r message = FALSE, echo = FALSE}
source(here::here("scratch", "asg_players.R"))

player_names_ids <- read_csv(here::here(
  "inst",
  "player_names_ids.csv"
))
```

## The All Stars

First lets take a look at our [starters](http://www.nba.com/article/2019/01/24/captains-lebron-giannis-headline-2019-all-star-starters):

```{r asg-starters}
asg_starters %>%
  select(player, team_slug) %>%
  gt() %>%
  tab_header(
    title = md("**NBA All-Star Game Starters**"),
  ) %>%
  cols_label(player = md("**Player Name**"),
             team_slug = md("**Team**")) %>%
  tab_footnote(
    footnote = "Team captain",
    locations = cells_data(
      columns = vars(player),
      rows = c(1, 8))
  ) %>%
  tab_options(footnote.glyph = c("*, †, ‡"))
```

Now the [All-Star reserves](http://www.nba.com/article/2019/01/31/big-names-highlight-nba-all-star-reserves):

```{r asg-reserves}
asg_reserves %>%
  select(player, team_slug) %>%
  gt() %>%
  tab_header(
    title = md("**NBA All-Star Game Reserves**"),
  ) %>%
  cols_label(player = md("**Player Name**"),
             team_slug = md("**Team**"))
```

We've also got a category I'm calling "specials." Brooklyn Nets guard [**D'Angelo Russell**](http://www.nba.com/players/d%27angelo/russell/1626156) was named by NBA Commissioner Adam Silver as the replacement for [**Victor Oladipo**](http://www.nba.com/players/victor/oladipo/203506), who ruptured a quad tendon in a game against the Raptors on January 23.[^dlo]

Silver also added [**Dirk Nowitzki**](http://www.nba.com/players/dirk/nowitzki/1717) and [**Dwyane Wade**](http://www.nba.com/players/dwyane/wade/2548) as "special team roster additions" because, well, they're Dirk Nowitzki and D. Wade.[^nowwade]

```{r asg-special}
asg_special %>%
  select(player, team_slug) %>%
  gt() %>%
  tab_header(
    title = md("**NBA All-Star Game Special Selections**"),
  ) %>%
  cols_label(player = md("**Player Name**"),
             team_slug = md("**Team**"))
```

## The Votes

We've got voting data, which I scraped and wrangled in an earlier missive.[^asgvotes]

```{r west-front, echo = FALSE}
asg_votes %>%
  filter(conf_court == "western frontcourt") %>%
  arrange(weighted_score) %>%
  mutate(rank = row_number()) %>%
  filter(rank <= 10) %>%
  select(rank, player, team_slug, fan_rank, player_rank, media_rank, weighted_score) %>%
  gt() %>%
  tab_header(
    title = md("**Western Conference Frontcourt**"),
    subtitle = glue::glue("NBA All-Star Voting 2019 Results")
  ) %>%
  cols_label(rank = md("**Rank**"),
             player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
    tab_footnote(
    footnote = "Voted to start",
    locations = cells_data(
      columns = vars(player),
      rows = 1:3)
  ) %>%
    tab_footnote(
    footnote = "Team captain",
    locations = cells_data(
      columns = vars(player),
      rows = 1)
  ) %>%
    tab_footnote(
    footnote = "Tiebreaker for starting spot is fan rank",
    locations = cells_data(
    columns = vars(weighted_score),
    rows = 3:4)
  ) %>%
  tab_options(footnote.glyph = c("*, †, ‡"),
              table.width = px(900))
```


```{r west-back, echo = FALSE}
asg_votes %>%
  filter(conf_court == "western backcourt") %>%
  arrange(weighted_score) %>%
  mutate(rank = row_number()) %>%
  filter(rank <= 10) %>%
  select(rank, player, team_slug, fan_rank, player_rank, media_rank, weighted_score) %>%
  gt() %>%
  tab_header(
    title = md("**Western Conference Backcourt**"),
    subtitle = glue::glue("NBA All-Star Voting 2019 Results")
  ) %>%
  cols_label(rank = md("**Rank**"),
             player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
    tab_footnote(
    footnote = "Voted to start",
    locations = cells_data(
      columns = vars(player),
      rows = 1:2)
  ) %>%
  tab_options(footnote.glyph = c("*, †, ‡"),
              table.width = px(900))
```

```{r east-front, echo = FALSE}
asg_votes %>%
  filter(conf_court == "eastern frontcourt") %>%
  arrange(weighted_score) %>%
  mutate(rank = row_number()) %>%
  filter(rank <= 10) %>%
  select(rank, player, team_slug, fan_rank, player_rank, media_rank, weighted_score) %>%
  gt() %>%
  cols_label(rank = md("**Rank**"),
             player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
  tab_header(
    title = md("**Eastern Conference Frontcourt**"),
    subtitle = glue::glue("NBA All-Star Voting 2019 Results")
  ) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
    tab_footnote(
    footnote = "Voted to start",
    locations = cells_data(
      columns = vars(player),
      rows = 1:3)
  ) %>%
    tab_footnote(
    footnote = "Team captain",
    locations = cells_data(
      columns = vars(player),
      rows = 1)
  ) %>%
  tab_options(footnote.glyph = c("*, †, ‡"),
              table.width = px(900))
```


```{r east-back, echo = FALSE}
asg_votes %>%
  filter(conf_court == "eastern backcourt") %>%
  arrange(weighted_score) %>%
  mutate(rank = row_number()) %>%
  filter(rank <= 10) %>%
  select(rank, player, team_slug, fan_rank, player_rank, media_rank, weighted_score) %>%
  gt() %>%
  tab_header(
    title = md("**Eastern Conference Backcourt**"),
    subtitle = glue::glue("NBA All-Star Voting 2019 Results")
  ) %>%
  cols_label(rank = md("**Rank**"),
             player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
    tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
    tab_footnote(
    footnote = "Voted to start.",
    locations = cells_data(
      columns = vars(player),
      rows = 1:2)
  ) %>%
  tab_options(footnote.glyph = c("*, †, ‡"),
              table.width = px(900))
```

## Munging data in

Let's get some more data on our actual _selected_ All-Star team. First I'll combine the starters, reserves, and "specials" into a single data frame.

```{r}
asg_players <- bind_rows(asg_starters, asg_reserves, asg_special)
```

Next will bring in the All-Star voting data Note that I'm using two columns for the join _not_ because I necessarily need them, but to avoid name repair which (by default) would leave me with two variables, `team_slug.x` and `team_slug.y`, in the resulting data frame.

```{r}
asg_data <- asg_players %>%
  left_join(asg_votes, by = c("player", "team_slug"))
```

I'm also gonna ditch those last four columns, since they were a mess of my own making from the initial data scraping, and I'm pretty sure they have variable names that will bork something up somewhere.

```{r}
asg_data <- asg_data[,1:13]
```

## Selections vs. Voted Rankings

Next, let's take a look at the players who were "least deserving" of their selection according to player, fan, and media rankings. We'll group by `conf_court`, since the voting is does that way, and, thus each combination of Eastern/Western conferences and front/back courts has their own ranking.

```{r}
rank_vars <- c("player", "team_slug", "player_rank", "fan_rank", "media_rank", "weighted_score", "conf_court")

asg_data %>%
  group_by(conf_court) %>%
  filter(player_rank == max(player_rank)) %>%
  select(rank_vars) %>%
  gt() %>%
  tab_header(
    title = md("**Least Deserving: Player Rank**"),
  ) %>%
  cols_label(player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
  tab_style(
    style = cells_styles(
      bkgd_color = "lightpink"),
    locations = cells_data(
      columns = vars(player_rank)
      )
    ) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
  tab_options(stub_group.font.weight = "600",
              sourcenote.padding = px(10))
```

<br />

```{r echo=FALSE}
asg_data %>%
  group_by(conf_court) %>%
  filter(fan_rank == max(fan_rank)) %>%
  select(rank_vars) %>%
  gt() %>%
  tab_header(
    title = md("**Least Deserving: Fan Rank**"),
  ) %>%
  cols_label(player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
  tab_style(
    style = cells_styles(
      bkgd_color = "lightpink"),
    locations = cells_data(
      columns = vars(fan_rank)
      )
    ) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
  tab_options(stub_group.font.weight = "600",
              sourcenote.padding = px(10))
```

<br />

```{r echo=FALSE}
asg_data %>%
  group_by(conf_court) %>%
  filter(media_rank == max(media_rank)) %>%
  select(rank_vars) %>%
  gt() %>%
  tab_header(
    title = md("**Least Deserving: Media Rank**"),
  ) %>%
  cols_label(player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
  tab_style(
    style = cells_styles(
      bkgd_color = "lightpink"),
    locations = cells_data(
      columns = vars(media_rank)
      )
    ) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
  tab_options(stub_group.font.weight = "600",
              sourcenote.padding = px(10))
```

<br />

Why so many in this last round? Well, the media happened to have quite a few ties. Don't worry, they haven't _totally_ lost their minds. They've got [**Damian Lillard**](http://www.nba.com/players/damian/lillard/203081) ranked number 4 for Western Conference Guards, tied with [**Klay Thompson**](http://www.nba.com/players/klay/thompson/202691). Klay's an interesting case, because though he's definitely got the fans and media behind him, he's only ranked 11th by his peers.

It's not surprising that we see Nowitzki in all three. Dude's a legend, playing at 41, and this is a "sentimental" pick on a lot of levels. DLo (D'Angelo Russell) is another story, though. I'm not saying he doesn't deserve it — he's been great this season, but (if you take a look at the table above for **Eastern Backcourt**), by votes alone, the players, fans, and media all had several players lined up before him.

## Player faves not selected

*__Based on the votes of their peers, who was low-key robbed?__*

We'll grab the top seven players from each segment according to player rankings. Then we can see who among them was _not_ selected to play in the All-Star Game.

I like this little not in operator `%ni%`, from a [post on Stack Overflow](https://stackoverflow.com/questions/5831794/opposite-of-in) by Spencer Castro.[^nin] So, I'll use that to get my player list.

```{r nin}
'%ni%' <- Negate('%in%')
```


```{r player-top-10}
player_top7 <- asg_votes %>%
  filter(player_rank <= 7) 

top7_nin_asg <- player_top7 %>%
  filter(player %ni% asg_players$player)
```


```{r top10-nin, echo = FALSE}
top7_nin_asg %>%
  arrange(player_rank) %>%
  select(player, team_slug, fan_rank, player_rank, media_rank, weighted_score) %>%
  gt() %>%
  tab_header(
    title = md("**Top players by player votes _not_ on All-Star Roster**"),
    subtitle = glue::glue("NBA All-Star Voting 2019 Results")
  ) %>%
  cols_label(player = md("**Player Name**"),
             team_slug = md("**Team**"),
             fan_rank = md("**Fan Rank**"),
             player_rank = md("**Player Rank**"),
             media_rank = md("**Media Rank**"),
             weighted_score = md("**Weighted Score**")) %>%
  tab_style(
    style = cells_styles(
      bkgd_color = "lightgoldenrodyellow"),
    locations = cells_data(
      columns = vars(player_rank)
      )
    ) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
  tab_options(sourcenote.padding = px(10))
```



Looks like [**Jimmy Butler**](http://www.nba.com/players/jimmy/butler/202710) and [**Derrick Rose**](http://www.nba.com/players/derrick/rose/201565) were robbed from players' standpoint. 

Lest you think everyone was in agreement about that, the media were a pretty consistent voting block, and, the way rankings were done, this means players with zero media votes all tied for... Well, let's see:

```{r media-novote}
asg_votes %>%
  group_by(conf_court) %>%
  filter(media_rank == max(media_rank)) %>%
  select(media_total_votes, media_rank, conf_court) %>%
  distinct() %>%
  gt() %>%
  tab_header(
    title = md("**Media All-Star No Votes and Rank**"),
    subtitle = glue::glue("NBA All-Star Voting 2019 Results")
    ) %>%
  cols_label(
    media_total_votes = md("**Media Votes**"),
    media_rank = md("**Media Rank**")
    ) %>%
    tab_source_note(md("source: [nba.com](http://www.nba.com/article/2019/01/24/2019-nba-all-star-starters-revealed-official-release)")) %>%
  tab_options(stub_group.font.weight = "600",
              sourcenote.padding = px(10))
  
```

<br />

So, yeah, Jimmy Butler was 7th in media rank...along with every other frontcourt player from the Eastern Conference who got zero media votes.

## Team LeBron vs. Team Giannis

The conference captains, [**LeBron James**](http://www.nba.com/players/lebron/james/2544) and [**Giannis Antetokounmpo**](http://www.nba.com/players/giannis/antetokounmpo/203507), [drafted](http://www.nba.com/allstar/2019/draft) their teams on February 8th. Here's how that shook out:

```{r read-asg-draft, echo = TRUE}
allstar_teams <- read_csv(here::here("data", "ASG", "allstar_teams.csv"))
```

```{r}
asg_player_teamslug <- asg_data %>%
  dplyr::select(player, team_slug)
```


```{r asg-draft}
allstar_teams %>%
  left_join(asg_player_teamslug, by = "player") %>%
  gt() %>%
  tab_header(
    title = md("**Draft Results: Team LeBron vs. Team Giannis**"),
    subtitle = glue::glue("2019 NBA All-Star Rosters")
  ) %>%
  cols_label(
    draft_pick = md("**Pick**"),
    player = md("**Player**"),
    allstar_team = md("**All-Star Team**"),
    team_slug = md("**NBA Team**")
  ) %>%
    tab_source_note(md("source: [nba.com](http://www.nba.com/allstar/2019/draft)")) %>%
    tab_footnote(
    footnote = "Traded after draft",
    locations = cells_data(
      columns = vars(player),
      rows = c(13, 16))
  ) %>%
  tab_options(footnote.glyph = c("*, †, ‡"))
```

Since there are no rules prohibiting trades (this is only the second year the NBA has drafted all-star teams rather than splitting them by conference), Giannis and LeBron went ahead and swapped [**Ben Simmons**](http://www.nba.com/players/ben/simmons/1627732) and [**Russell Westbrook**](http://www.nba.com/players/russell/westbrook/201566) after the draft.[^trade]

```{r allstar-results}
allstar_results <- read_csv(here::here("data", "ASG", "allstar_results.csv"))

allstar_results %>%
  left_join(asg_player_teamslug, by = "player") %>%
  mutate(status = case_when(
    starter == TRUE ~ "Starters",
    TRUE ~ "Reserves"
  )) %>%
  dplyr::select(player, allstar_team, status, team_slug) %>%
  group_by(allstar_team, status) %>%
  gt(rowname_col = "player") %>%
  tab_header(
    title = md("**2019 NBA All-Star Teams**")
  ) %>%
  cols_label(
    team_slug = md("**NBA Team**")
  ) %>%
  tab_source_note(md("source: [nba.com](http://www.nba.com/allstar/2019/draft)")) %>%
  tab_options(
    stub_group.font.weight = "600"
  )
```

```{r asg-results-wide}
allstar_spread <- allstar_results %>%
  tibble::rowid_to_column() %>%
  spread(allstar_team, player) %>%
  mutate(status = case_when(
    starter == TRUE ~ "Starters",
    TRUE ~ "Reserves"
  )) %>%
  dplyr::select(status, `Team Giannis`, `Team LeBron`)


team_giannis <- allstar_spread %>%
  filter(!is.na(`Team Giannis`)) %>%
  dplyr::select(status, `Team Giannis`)

team_lebron <- allstar_spread %>%
  filter(!is.na(`Team LeBron`)) %>%
  dplyr::select(status, `Team LeBron`)

spread_teams <- team_giannis %>%
  bind_cols(team_lebron) %>%
  select(-status1)
```

```{r gt-spread}
spread_teams %>%
  group_by(status) %>%
  gt() %>%
  tab_options(
    table.background.color = "midnightblue",
    column_labels.font.weight = "600",
  )
```

## Hashflag fun

How about we take a look at those pretty hashflags they've got going on Twitter for All-Star Weekend? Since Twitter apparently doesn't know how to follow a naming convention, I manually populated a spreadsheet with the necessary info.

```{r}
allstar_hashflags <- readr::read_csv(here::here("data", "ASG", "allstar_hashflags.csv"))
```


```{r hashflag-both}
allstar_hashflags %>%
  mutate(status = case_when(
    starter == TRUE ~ "Starters",
    TRUE ~ "Reserves"
  )) %>%
  dplyr::select(player, allstar_team, status, hashflag_url) %>%
  group_by(allstar_team, status) %>%
  gt(rowname_col = "player") %>%
  text_transform(
    locations = cells_data(vars(hashflag_url)),
    fn = function(x) {
      web_image(url = x) 
    }
  ) %>%
  tab_header(
    title = html(
      "<strong>2019 NBA All-Star Teams</strong>",
      web_image(
        url = "https://abs.twimg.com/hashflags/NBAAllstarMain2019/NBAAllstarMain2019.png"
      )
      )
  ) %>%
  cols_label(
    hashflag_url = md("**Hashflag**")
  ) %>%
  tab_options(
    stub_group.font.weight = "600",
    row.striping.include_stub = TRUE,
    table.width = pct(40)
  ) %>%
  tab_style(
    locations = cells_data(vars(hashflag_url)),
    cells_styles(text_align = "center")
  )
```

<br />

```{r hashflags-giannis}
asw_giannis <- allstar_hashflags %>%
  filter(allstar_team == "Team Giannis")

asw_giannis %>%
  mutate(status = case_when(
    starter == TRUE ~ "Starters",
    TRUE ~ "Reserves"
  )) %>%
  dplyr::select(player, status, hashflag_url) %>%
  group_by(status) %>%
  gt(rowname_col = "player") %>%
  text_transform(
    locations = cells_data(vars(hashflag_url)),
    fn = function(x) {
      web_image(url = x) 
    }
  ) %>%
  tab_header(
    title = html(
      "<strong>Team Giannis</strong>",
      web_image(
        url = "https://abs.twimg.com/hashflags/TeamGiannis-ASW19/TeamGiannis-ASW19.png"
      )
      ),
    subtitle = md("2019 NBA All-Star Game")
  ) %>%
  cols_label(
    hashflag_url = md("**Hashflag**")
  ) %>%
  tab_options(
    stub_group.font.weight = "600",
    row.striping.include_stub = TRUE,
    table.width = px(300)
  ) %>%
  tab_style(
    locations = cells_data(vars(hashflag_url)),
    cells_styles(text_align = "center")
  )
```

<br />

```{r hashflag-lebron}
asw_lebron <- allstar_hashflags %>%
  filter(allstar_team == "Team LeBron")

asw_lebron %>%
  mutate(status = case_when(
    starter == TRUE ~ "Starters",
    TRUE ~ "Reserves"
  )) %>%
  dplyr::select(player, status, hashflag_url) %>%
  group_by(status) %>%
  gt(rowname_col = "player") %>%
  text_transform(
    locations = cells_data(vars(hashflag_url)),
    fn = function(x) {
      web_image(url = x) 
    }
  ) %>%
  tab_header(
    title = html(
      "<strong>Team LeBron</strong>",
      web_image(
        url = "https://abs.twimg.com/hashflags/TeamLBJ-ASW19/TeamLBJ-ASW19.png"
      )
      ),
    subtitle = md("2019 NBA All-Star Game")
  ) %>%
  cols_label(
    hashflag_url = md("**Hashflag**")
  ) %>%
  tab_options(
    stub_group.font.weight = "600",
    row.striping.include_stub = TRUE,
    table.width = px(300)
  ) %>%
  tab_style(
    locations = cells_data(vars(hashflag_url)),
    cells_styles(text_align = "center")
  )
```

<br />

[^dlo]: "Nets' Russell replaces injured Oladipo in All-Star Game" <http://www.nba.com/article/2019/02/01/dangelo-russell-replaces-victor-oladipo-all-star-roster>
[^nowwade]: "Wade, Nowitzki named special roster additions for All-Star Game" <http://www.nba.com/article/2019/02/01/dirk-nowitzki-dwyane-wade-added-all-star-game>
[^asgvotes]: "NBA All-Star Games: Votes" <http://rpubs.com/maraaverick/nba-asg-votes-2019>
[^nin]: "Opposite of `%in%`" <https://stackoverflow.com/questions/5831794/opposite-of-in>
[^trade]: You can watch the video [here](http://www.nba.com/allstar/2019/draft), it's pretty adorable.