---
title: "A Race Winning Strategy"
author: 'Kyle Grealis'
date: 'June 23, 2024'
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{A Race Winning Strategy}
  %\VignetteEngine{quarto::html}
  %\VignetteEncoding{UTF-8}
knitr:
  opts_chunk:
    message: false
    warning: false
    error: false
    comment: ""      # don't show ## with printed output
    dpi: 100         # image resolution (typically 300 for publication)
    fig-width: 6.5   # figure width
    fig-height: 4.0  # figure height
bibliography: [references.bib, packages.bib]
csl: the-new-england-journal-of-medicine.csl
---

```{r}
#| label: load_packages
#| echo: false
library(conflicted)
library(ggtext)
library(glue)
library(gtsummary)
library(rUM)
library(tidyverse)

conflicted::conflict_prefer('filter', 'dplyr')
# suppress "`summarise()` has grouped output by " messages
options(dplyr.summarise.inform = FALSE)
```

## In the Pits

NASCAR is one of the top-tier racing sports in North America and competes against F1 and IndyCar for the top viewership spot. Approximately 3.22 million people watch a race on any given weekend throughout the season. The `nascaR.data` package is the result of wanting to share a passion for the sport and provide an option to the typical go-to packages when learning new data visualization tools. 

`nascaR.data` is packed full of NASCAR results dating back to the first Daytona Beach race in 1949! Use this package to discover race trends across the NASCAR Cup Series, Xfinity Series, and Craftsman Truck Series. Answer fun questions like "which driver has accumulated the most wins overall?", "which owner has the best top 10 percentage at Daytona?", or see which manufacturer has dominated which series in a certain season. It's all here, so let's strap in to our race seats, fire up those engines, and let's take some warm-up laps.

## Warming up the tires

`nascaR.data` provides access to 21 different datasets (7 per series) and are broken down by overall race results and driver, owner, and manufacturer season & career records. Let's check our gauges and see what's under the hood:

```{r}
#| echo: true
library(nascaR.data)
```

Use `?nascaR.data::cup_race_data` to view a list of variable descriptions. This package has been designed to swap `cup` for `xfinity` or `truck` to see the same data structure (variables) for the respective series. Would you rather inspect driver-specific results listed by season or their overall career? No problem... this is an easy pit stop: `cup_driver_career` or `xfinity_owner_season` or `truck_mfg_overall`.

::: {.callout-note}
Manufacturer (`mfg`) results use the term "overall" instead of "career" as is used for driver and owner. 

`cup_mfg_overall` vs `cup_driver_career`
:::

## Green Flag!

**Which drivers are in the Top 5 for wins in the NASCAR Cup Series?**

First, organize the drivers in descending order by win. Then, subset to keep the Top 5 winningest drivers. Lastly, feed the data into a horizontal bar chart (some other tweaks will be applied to enhance the visual output).

```{r}
#| echo: true
#| eval: false
cup_driver_career |>
  arrange(desc(career_wins)) |>
  slice_head(n = 5) |>
  ggplot(aes(driver, career_wins)) +
  geom_bar(stat = 'identity') +
  coord_flip()
```

```{r}
#| echo: false
#| warning: false

driver_colors = c(
  'Richard Petty' = '#04aeec',
  'David Pearson' = '#630727',
  'Jeff Gordon' = '#fc3812',
  'Bobby Allison' = '#e4be8f',
  'Darrell Waltrip' = '#24987a'
)

cup_driver_career |>
  arrange(desc(career_wins)) |>
  slice_head(n = 5) |>
  ggplot(aes(fct_reorder(driver, career_wins), career_wins, fill = driver)) +
  geom_bar(stat = 'identity', color = 'black', alpha = 0.8) +
  geom_text(
    aes(label = career_wins), vjust = 0.65, color = 'black',
    size = 3.5, hjust = 1.4
  ) +
  coord_flip() +
  theme_minimal() +
  scale_fill_manual(values = driver_colors) +
  labs(
    title = 'NASCAR Cup Series Top 5 winning drivers',
    subtitle = 'Career wins',
    caption = 'Source: NASCAR.com',
    x = NULL,
    y = 'Career Wins'
  ) +
  theme(
    legend.position = 'none',
    plot.title = element_text(
      color = 'black', face = 'bold', size = rel(1.5), 
      # hjust = -0.45
    ),
    plot.subtitle = element_text(
      color = 'black', size = rel(1.1), 
      # hjust = -0.195
    ),
    axis.text = element_text(color = 'black'),
    axis.text.x = element_blank()
  )
```

Wow! This doesn't even look like a close race. Richard Petty clearly leads the field with 200 wins. However, let's take a drive a little deeper into the turn and account for the number of races each driver competed in. What if we compare these same five drivers by win percentage?

```{r}
#| echo: true
#| eval: false
cup_driver_career |>
  arrange(desc(career_wins)) |>
  slice_head(n = 5) |>
  ggplot(aes(driver, career_win_pct)) +
  geom_bar(stat = 'identity') +
  coord_flip()
```

```{r}
#| echo: false
cup_driver_career |>
  arrange(desc(career_wins)) |>
  slice_head(n = 5) |>
  mutate(career_win_pct = round(career_win_pct, 3)) |>
  ggplot(aes(fct_reorder(driver, career_win_pct), career_win_pct, fill = driver)) +
  geom_bar(stat = 'identity', color = 'black', alpha = 0.8) +
  geom_text(
    aes(label = scales::percent(career_win_pct)), vjust = 0.65, color = 'black',
    size = 3.5, hjust = 1.1
  ) +
  coord_flip() +
  theme_minimal() +
  scale_fill_manual(values = driver_colors) +
  labs(
    title = 'NASCAR Cup Series Top 5 winning drivers',
    subtitle = 'Career win percentage',
    caption = 'Source: NASCAR.com',
    x = NULL,
    y = 'Career Win Percentage'
  ) +
  theme(
    legend.position = 'none',
    plot.title = element_text(
      color = 'black', face = 'bold', size = rel(1.5), 
      # hjust = -0.45
    ),
    plot.subtitle = element_text(
      color = 'black', size = rel(1.1), 
      # hjust = -0.23
    ),
    axis.text = element_text(color = 'black'),
    axis.text.x = element_blank()
  )
```

```{r}
#| echo: false
petty <- cup_driver_career |>
  filter(driver == 'Richard Petty') |>
  pull(career_races)

pearson <- cup_driver_career |>
  filter(driver == 'David Pearson') |>
  pull(career_races)
```

Accounting for Richard Petty's `r petty` races to David Pearson's `r pearson` races, imagine how many more wins Pearson would have if he competed in as many races as The King.

## The Garage Area

**Which manufacturer has the best win percentage by season?**

Let's go behind the pits and see what the manufacturers are up to in the Truck Series.

```{r}
#| eval: false
truck_mfg_season |>
  ggplot(aes(season, mfg_season_win_pct, group = manufacturer, color = manufacturer)) +
  geom_line() +
  geom_point()
```

```{r}
#| echo: false
mfg_colors = c(
  'Chevrolet' = '#c5b358',
  'Dodge' = 'darkcyan',
  'Ford' = '#003478',
  'RAM' = '#94979c',
  'Toyota' = '#eb0a1e'
)

truck_mfg_season |>
  ggplot(aes(season, mfg_season_win_pct, group = manufacturer, color = manufacturer)) +
  geom_line(alpha = 0.8) +
  geom_point() +
  theme_minimal() +
  scale_color_manual(values = mfg_colors) +
  scale_y_continuous(labels = scales::percent) +
  labs(
    title = 'NASCAR Truck Series Manufacturer Win Percentage',
    caption = 'Source: NASCAR.com',
    x = NULL, y = NULL
  ) +
  theme(
    legend.position = 'top',
    legend.title = element_blank(),
    plot.title = element_text(
      color = 'black', face = 'bold', size = rel(1.35)
    ),
    plot.subtitle = element_text(
      color = 'black', size = rel(1.1)
    ),
    axis.text = element_text(color = 'black')
  )
```

No clear trend emerges, though it appears that there may be a 5-year clustering of winning percentage. For example, the Dodges experienced success in the early 2000s, but started to fall off before exiting the series. And while Ford has seemingly had gradual improvement, you can clearly see the success of the Toyota camp since joining the Truck series in 2004.

## Post-race

**Collect your race winnings**

How has the average money for winning a race changed over time?

```{r}
#| eval: false
cup <- cup_race_data |>
  mutate(series = 'Cup') |>
  filter(finish == 1) |>
  select(season, race, finish, money, series)

xfinity <- xfinity_race_data |>
  mutate(series = 'Xfinity') |>
  filter(finish == 1) |>
  select(season, race, driver, money, series)

truck <- truck_race_data |>
  mutate(series = 'Truck') |>
  filter(finish == 1) |>
  select(season, race, driver, money, series)

bind_rows(cup, xfinity, truck) |>
  group_by(series, season) |>
  summarize(mean_money = mean(money, na.rm = TRUE)) |>
  ggplot(aes(season, mean_money, group = series, color = series)) +
  geom_point() +
  geom_line()
```

```{r}
#| echo: false
flags = c(
  'Cup' = 'darkgreen',
  'Xfinity' = 'gold',
  'Truck' = 'black'
)

cup <- cup_race_data |>
  mutate(series = 'Cup') |>
  filter(finish == 1) |>
  select(season, race, finish, money, series)

xfinity <- xfinity_race_data |>
  mutate(series = 'Xfinity') |>
  filter(finish == 1) |>
  select(season, race, driver, money, series)

truck <- truck_race_data |>
  mutate(series = 'Truck') |>
  filter(finish == 1) |>
  select(season, race, driver, money, series)

bind_rows(cup, xfinity, truck) |>
  group_by(series, season) |>
  summarize(mean_money = mean(money, na.rm = TRUE)) |>
  ggplot(aes(season, mean_money, group = series, color = series)) +
  geom_point() +
  geom_line() +
  theme_minimal() +
  scale_color_manual(values = flags) +
  scale_y_continuous(labels = scales::label_dollar(scale = 1, prefix = '$')) +
  labs(
    title = 'NASCAR Race Money by Season',
    subtitle = 'Race winnings were not reported since 2016',
    caption = 'Source: NASCAR.com',
    x = NULL, y = NULL
  ) +
  theme(
    legend.position = 'top',
    legend.title = element_blank(),
    plot.title = element_text(
      color = 'black', face = 'bold', size = rel(1.35)
    ),
    plot.subtitle = element_text(
      color = 'black', size = rel(0.8)
    ),
    axis.text = element_text(color = 'black')
  )
```

Race winnings in the Cup series experienced exponential growth beginning in the 1980s while Xfinity and Truck Series winnings have remained relatively the same since 2000.

## The Backstretch

I hope this gives you a little taste of what is included in this package. There's plenty of opportunity to further clean and reshape the data for data visualizations or model prepping. I'll be adding more data throughout the season.

## Toolbox

`nascaR.data` was built with `r stringr::word(R.Version()$version.string, 1, 3)` with the `tidyverse` (`r packageVersion("tidyverse")`), `rUM` (`r packageVersion("rUM")`), and `ggtext` (`r packageVersion("ggtext")`) packages used to preprocess and summarize data. [@R-base; @R-tidyverse; @tidyverse2019; @R-rUM; @R-ggtext]


## References {.unnumbered}

```{r}
#| include: false

# automatically create a bib database for loaded R packages & rUM
knitr::write_bib(
  c(
    .packages(),
    "rUM"
  ),
  "packages.bib"
)
```
