Uncertainty Part 2a

class: center, middle, inverse, title-slide

.title[
# Uncertainty Part 2a
]
.subtitle[
## Sports Analytic Mania: Basics
]
.author[
### Prof. Weldzius
]
.institute[
### Villanova University
]

---

# Agenda

1. Uncertainty

2. More NBA data

3. \#TrustTheProcess

4. Conditional Means

---

# Sports Analytics

- Previously, we looked at players

- Specifically, `isRookie` and `tov`
  
  - But could try **many** other ideas
  
--

- Useful if we want a job scouting talent

- But what if we want to advise actual games?

- **Game Data**!

---

# Other NBA Data

- Load the `game_summary.Rds` data

``` r
require(tidyverse)
gms <- read_rds('../data/game_summary.Rds')
gms
```

```
## # A tibble: 7,380 × 16
##    idGame yearSeason dateGame   idTeam nameTeam locationGame
##     <dbl>      <int> <date>      <dbl> <chr>    <chr>       
##  1 2.16e7       2017 2016-10-25 1.61e9 Clevela… H           
##  2 2.16e7       2017 2016-10-25 1.61e9 New Yor… A           
##  3 2.16e7       2017 2016-10-25 1.61e9 Portlan… H           
##  4 2.16e7       2017 2016-10-25 1.61e9 Utah Ja… A           
##  5 2.16e7       2017 2016-10-25 1.61e9 Golden … H           
##  6 2.16e7       2017 2016-10-25 1.61e9 San Ant… A           
##  7 2.16e7       2017 2016-10-26 1.61e9 Miami H… A           
##  8 2.16e7       2017 2016-10-26 1.61e9 Orlando… H           
##  9 2.16e7       2017 2016-10-26 1.61e9 Dallas … A           
## 10 2.16e7       2017 2016-10-26 1.61e9 Indiana… H           
## # ℹ 7,370 more rows
## # ℹ 10 more variables: tov <dbl>, pts <dbl>, treb <dbl>,
## #   oreb <dbl>, pctFG <dbl>, pctFT <dbl>, teamrest <dbl>,
## #   second_game <lgl>, isWin <lgl>, ft_80 <dbl>
```

---

# Other NBA Data

- Contains data on every game played between 2016 and 2019

``` r
gms %>%
  ggplot(aes(x = dateGame)) +
  geom_bar(stat = 'count')
```

---

# Other NBA Data

- Contains data on every game played between 2016 and 2019

``` r
gms %>%
  ggplot(aes(x = dateGame)) +
  geom_bar(stat = 'count')
```

- *Pause*: What happens when you keep `geom_bar()` blank? What about `geom_bar(stat = 'identity)`?

---

# Other NBA Data

``` r
glimpse(gms)
```

```
## Rows: 7,380
## Columns: 16
## $ idGame       <dbl> 21600001, 21600001, 21600002, 2160000…
## $ yearSeason   <int> 2017, 2017, 2017, 2017, 2017, 2017, 2…
## $ dateGame     <date> 2016-10-25, 2016-10-25, 2016-10-25, …
## $ idTeam       <dbl> 1610612739, 1610612752, 1610612757, 1…
## $ nameTeam     <chr> "Cleveland Cavaliers", "New York Knic…
## $ locationGame <chr> "H", "A", "H", "A", "H", "A", "A", "H…
## $ tov          <dbl> 14, 18, 12, 11, 16, 13, 10, 11, 15, 1…
## $ pts          <dbl> 117, 88, 113, 104, 100, 129, 108, 96,…
## $ treb         <dbl> 51, 42, 34, 31, 35, 55, 52, 45, 49, 5…
## $ oreb         <dbl> 11, 13, 5, 6, 8, 21, 16, 15, 10, 8, 1…
## $ pctFG        <dbl> 0.4833077, 0.3220769, 0.4310000, 0.51…
## $ pctFT        <dbl> 0.7500000, 0.8055000, 1.0000000, 1.00…
## $ teamrest     <dbl> 120, 120, 120, 120, 120, 120, 120, 12…
## $ second_game  <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FA…
## $ isWin        <lgl> TRUE, FALSE, TRUE, FALSE, FALSE, TRUE…
## $ ft_80        <dbl> 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0…
```

---

# Codebook

| Name         |                                          Description |
|--------------|-----------------------------------------------------:|
| idGame       |                                       Unique game id |
| yearSeason   | Which season? NBA uses ending year so 2016-17 = 2017 |
| dateGame     |                                     Date of the game |
| idTeam       |                                       Unique team id |
| nameTeam     |                                            Team Name |
| locationGame |                        Game location, H=Home, A=Away |
| tov          |                                      Total turnovers |
| pts          |                                         Total points |
| treb         |                                       Total rebounds |
| pctFG        |                                Field Goal Percentage |
| teamrest     |               How many days since last game for team |
| pctFT        |                                Free throw percentage |
| isWin        |                                   Won? TRUE or FALSE |
| ft_80        |      Team scored more than 80 percent of free throws |

---

# Codebook

- Which of these are categorical? Which are continuous?

- Remember the **process**!
  
--

- `isWin` as an ordered binary

``` r
gms %>%
  count(isWin)
```

```
## # A tibble: 2 × 2
##   isWin     n
##   <lgl> <int>
## 1 FALSE  3690
## 2 TRUE   3690
```

---

# Codebook

- The same number for wins and losses?

``` r
gms %>%
  select(idGame,nameTeam,dateGame,locationGame,isWin) %>% head()
```

```
## # A tibble: 6 × 5
##     idGame nameTeam            dateGame   locationGame isWin
##      <dbl> <chr>               <date>     <chr>        <lgl>
## 1 21600001 Cleveland Cavaliers 2016-10-25 H            TRUE 
## 2 21600001 New York Knicks     2016-10-25 A            FALSE
## 3 21600002 Portland Trail Bla… 2016-10-25 H            TRUE 
## 4 21600002 Utah Jazz           2016-10-25 A            FALSE
## 5 21600003 Golden State Warri… 2016-10-25 H            FALSE
## 6 21600003 San Antonio Spurs   2016-10-25 A            TRUE
```

- Each row is a **team-game** pair

- i.e., the Cavs hosted the Knicks on October 25, 2016 and won!
  
---

# The Knicks

---

# .blue[Science]

- What predicts winning?

- Points? (more is better)
  - Turnovers? (less is better)
  - Rebounds? (more is better)
  
--

- How confident are we?

``` r
gms %>%
  group_by(isWin) %>%
  summarise(avgTO = mean(tov))
```

```
## # A tibble: 2 × 2
##   isWin avgTO
##   <lgl> <dbl>
## 1 FALSE  13.9
## 2 TRUE   13.1
```

---

# Turnovers and Winning

- On average, winning teams have ~1 fewer turnover than losing teams

- FSNoR: is this *always* the case?

``` r
gms %>%
  filter(yearSeason == 2017) %>%
  group_by(isWin) %>%
  summarise(avgTO = mean(tov))
```

```
## # A tibble: 2 × 2
##   isWin avgTO
##   <lgl> <dbl>
## 1 FALSE  13.8
## 2 TRUE   12.9
```

---

# Turnovers and Winning

- On average, winning teams have ~1 fewer turnover than losing teams

- FSNoR: is this *always* the case?

``` r
gms %>%
  filter(yearSeason == 2018) %>%
  group_by(isWin) %>%
  summarise(avgTO = mean(tov))
```

```
## # A tibble: 2 × 2
##   isWin avgTO
##   <lgl> <dbl>
## 1 FALSE  14.1
## 2 TRUE   13.3
```

---

# Turnovers and Winning

- On average, winning teams have ~1 fewer turnover than losing teams

- FSNoR: is this *always* the case?

``` r
gms %>%
  group_by(isWin,yearSeason) %>%
  summarise(avgTO = mean(tov)) %>%
  spread(isWin,avgTO,sep = '_')
```

```
## # A tibble: 3 × 3
##   yearSeason isWin_FALSE isWin_TRUE
##        <int>       <dbl>      <dbl>
## 1       2017        13.8       12.9
## 2       2018        14.1       13.3
## 3       2019        13.9       13.1
```

---

# Turnovers and Winning

- On average, winning teams have ~1 fewer turnover than losing teams

- FSNoR: is this *always* the case?

- Not literally (numbers change)

- But practically?
  
- How **confident** are we in making this claim?

- In each season, the average turnovers of winning teams are roughly 1 lower than the average turnovers of losing teams
  
--

- Use **bootstrap sampling** to express this more concretely!