NBA Historical Game Data EDA

---

Dataset: 62,361 NBA games from the 1946–47 season through 2022–23.
Each row represents one game and contains both the home and away team’s box-score statistics.

To knit this document, place nba_historical_game_data_64000.csv in the same directory as this .Rmd file, then click Knit in RStudio (or run rmarkdown::render("nba_eda.Rmd")).

Required packages — install once with:

install.packages(c("tidyverse", "scales", "ggthemes",
                   "patchwork", "naniar", "corrplot", "kableExtra"))

---

1 Setup & Data Loading

1.1 Load Libraries

library(tidyverse)    # Core data wrangling and ggplot2 visualisation
library(scales)       # Helpers for axis labels: percent_format(), comma(), etc.
library(ggthemes)     # Extra ggplot2 themes (not heavily used here but handy)
library(patchwork)    # Combine multiple ggplot objects with / and | operators
library(naniar)       # Missing-data diagnostics and visualisation
library(corrplot)     # Correlation matrix heatmap
library(kableExtra)   # Styled HTML tables inside R Markdown
library(tinytex)

1.2 Import the Data

df_raw <- read_csv("C:/Users/buttsr/Desktop/R Studio Resources/Datasets/nba_historical_game_data_64000.csv")
View(df_raw)

1.3 First Look

# Print the number of rows and columns to confirm the file loaded correctly
cat(sprintf("Dimensions: %s rows × %d columns\n",
            format(nrow(df_raw), big.mark = ","),  # Format row count with comma separator
            ncol(df_raw)))                          # Print column count

## Dimensions: 62,361 rows × 54 columns

# Show the first 6 rows as a scrollable paged table
head(df_raw)

# Build a summary table of each column's R data type
tibble(
  column = names(df_raw),               # Extract all column names
  type   = map_chr(df_raw, ~ class(.x)[1])       # Apply class() to each column, return as character vector
) |>
  kbl(caption = "Column Names and Data Types") |>   # Render as an HTML table with a caption
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),  # Bootstrap table styles
                full_width = FALSE)                                        # Don't stretch to full page width

Column Names and Data Types

column	type
season_id	numeric
team_id_home	numeric
team_abbreviation_home	character
team_name_home	character
game_id	character
game_date	POSIXct
matchup_home	character
wl_home	character
min	numeric
fgm_home	numeric
fga_home	numeric
fg_pct_home	numeric
fg3m_home	numeric
fg3a_home	numeric
fg3_pct_home	numeric
ftm_home	numeric
fta_home	numeric
ft_pct_home	numeric
oreb_home	numeric
dreb_home	numeric
reb_home	numeric
ast_home	numeric
stl_home	numeric
blk_home	numeric
tov_home	numeric
pf_home	numeric
pts_home	numeric
plus_minus_home	numeric
video_available_home	numeric
team_id_away	numeric
team_abbreviation_away	character
team_name_away	character
matchup_away	character
wl_away	character
fgm_away	numeric
fga_away	numeric
fg_pct_away	numeric
fg3m_away	numeric
fg3a_away	numeric
fg3_pct_away	numeric
ftm_away	numeric
fta_away	numeric
ft_pct_away	numeric
oreb_away	numeric
dreb_away	numeric
reb_away	numeric
ast_away	numeric
stl_away	numeric
blk_away	numeric
tov_away	numeric
pf_away	numeric
pts_away	numeric
plus_minus_away	numeric
video_available_away	numeric

---

2 Data Cleaning & Feature Engineering

df <- df_raw |>
  filter(wl_home %in% c ("W", "L")) |>     # Remove any rows where wl_hoe is not W or L

  # ── Date & time ────────────────────────────────────────────────────────────
  mutate(
    game_date = as.Date(game_date),   # Convert the date string to a proper Date object

    # Extract the calendar year from season_id (e.g., 21946 → 1946)
    # season_id is a 5-digit integer; characters 2–5 hold the 4-digit year
    season    = as.integer(str_sub(as.character(season_id), 2, 5)),

    # Assign each season to its decade for grouped comparisons (e.g., 1987 → 1980)
    decade    = factor(floor(season / 10) * 10),

    # ── Derived outcome variables ───────────────────────────────────────────
    home_win   = (wl_home == "W"),         # TRUE/FALSE: did the home team win?
    point_diff = pts_home - pts_away,      # Signed margin: positive = home team ahead
    total_pts  = pts_home + pts_away       # Combined score of both teams
  )

# Confirm the date range and season count after cleaning
cat(sprintf(
  "Date range: %s → %s  |  Seasons: %d  |  Games: %s\n",
  min(df$game_date),               # Earliest game date
  max(df$game_date),               # Latest game date
  n_distinct(df$season),           # Number of unique seasons
  format(nrow(df), big.mark = ",") # Total game count formatted with comma
))

## Date range: 1946-11-01 → 2023-03-11  |  Seasons: 75  |  Games: 62,354

---

3 Missing Data

Understanding where data is absent is critical before any analysis — missing values here largely reflect stats that weren’t officially tracked in earlier NBA eras (e.g., blocks, steals, and 3-pointers before 1974–80).

# Build a summary table: for every column, compute count and percentage of NAs
miss_var_summary(df) |>          # naniar function; returns n_miss, pct_miss per variable
  filter(pct_miss > 0) |>        # Keep only columns that actually have missing values
  mutate(pct_miss = round(pct_miss, 1)) |>   # Round percentages to 1 decimal place
  kbl(caption = "Columns with Missing Values (% Missing)") |>   # Render as styled table
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

Columns with Missing Values (% Missing)

variable	n_miss	pct_miss
fg3_pct_home	21275	34.1
dreb_home	21272	34.1
dreb_away	21271	34.1
oreb_home	21203	34
oreb_away	21203	34
fg3_pct_away	21187	34
stl_home	21120	33.9
stl_away	21120	33.9
tov_away	20941	33.6
tov_home	20940	33.6
fg3a_home	20917	33.5
fg3a_away	20917	33.5
blk_home	20911	33.5
blk_away	20910	33.5
ast_home	18240	29.3
ast_away	18237	29.2
reb_home	18108	29
reb_away	18104	29
fg_pct_home	17900	28.7
fg_pct_away	17898	28.7
fga_home	17862	28.6
fga_away	17861	28.6
fg3m_home	15653	25.1
fg3m_away	15653	25.1
ft_pct_home	3039	4.9
fta_home	3036	4.9
ft_pct_away	3034	4.9
fta_away	3033	4.9
pf_home	2936	4.7
pf_away	2929	4.7
ftm_home	21	0
fgm_home	18	0
fgm_away	15	0
ftm_away	15	0

# Plot a horizontal bar chart of % missing values for each variable
gg_miss_var(df, show_pct = TRUE) +         # naniar wrapper; show_pct puts % on x-axis
  labs(
    title    = "Missing Values by Column",
    subtitle = "Advanced stats are absent for pre-1970s seasons",
    x        = "% Missing"
  ) +
  theme_minimal(base_size = 11)            # Clean minimal theme; base_size sets default text size

Key takeaway: About 25–34 % of advanced stats (3-pointers, rebounds, steals, blocks, turnovers) are missing — almost entirely because those categories weren’t recorded in the earliest decades of the league. Analyses using those columns are therefore restricted to the modern era.

---

4 Scoring Trends Over Time

4.1 Average Points per Season

# Aggregate to one row per season, computing mean points for each team side
scoring_by_season <- df |>
  group_by(season) |>                          # Group so each summarise() call operates per-season
  summarise(
    avg_pts_home  = mean(pts_home),            # Average home-team points for the season
    avg_pts_away  = mean(pts_away),            # Average away-team points for the season
    avg_total_pts = mean(total_pts),           # Average combined score per game
    n_games       = n(),                       # Number of games played in the season
    .groups = "drop"                           # Drop grouping after summarise to avoid downstream issues
  )

# Line chart showing all three scoring series across all seasons
ggplot(scoring_by_season, aes(x = season)) +

  # Shaded ribbon to visually anchor the total-points trend
  geom_ribbon(aes(ymin = 180, ymax = avg_total_pts),  # Fill between 180 baseline and the total line
              fill = "#E63946", alpha = 0.08) +        # Faint red fill

  # Bold red line for combined team scoring
  geom_line(aes(y = avg_total_pts, colour = "Total (both teams)"), linewidth = 1.3) +

  # Dashed blue line for home team scoring only
  geom_line(aes(y = avg_pts_home, colour = "Home"),  linewidth = 0.9, linetype = "dashed") +

  # Dotted teal line for away team scoring only
  geom_line(aes(y = avg_pts_away, colour = "Away"),  linewidth = 0.9, linetype = "dotted") +

  # LOESS smoother to show the long-run trend without seasonal noise
  geom_smooth(aes(y = avg_total_pts), method = "loess", se = FALSE,
              colour = "grey35", linetype = "longdash", linewidth = 0.7) +

  # Manually assign colours to each named series in the legend
  scale_colour_manual(values = c(
    "Total (both teams)" = "#E63946",
    "Home"               = "#457B9D",
    "Away"               = "#2A9D8F"
  )) +

  # Place x-axis tick marks every 10 years
  scale_x_continuous(breaks = seq(1950, 2025, 10)) +

  labs(
    title    = "Average Points Scored per Game by Season (1946–2023)",
    subtitle = "A scoring dip in the physical 1950s–60s era; a modern explosion from 2013 onward",
    x        = "Season",
    y        = "Avg Points per Game",
    colour   = NULL   # Remove the legend title (colour name is self-explanatory)
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "top")  # Move legend above the plot

4.2 Score Distribution by Decade

df |>
  filter(!is.na(decade)) |>              # Remove rows where decade could not be determined

  ggplot(aes(x = pts_home, fill = decade)) +

    # Overlapping density curves, one per decade; alpha makes them semi-transparent
    geom_density(alpha = 0.30, colour = NA) +     # colour = NA removes the curve border

    # Viridis "turbo" palette gives maximally distinct colours across many decades
    scale_fill_viridis_d(option = "turbo") +

    labs(
      title    = "Distribution of Home Team Points by Decade",
      subtitle = "Score distributions shift substantially — note the rightward drift since the 1990s",
      x        = "Home Points Scored",
      y        = "Density",
      fill     = "Decade"
    ) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "right")

---

5 Home Court Advantage

5.1 Win Percentage & Point Margin Over Time

# Compute per-season home-court advantage metrics
home_adv <- df |>
  group_by(season) |>
  summarise(
    home_win_pct = mean(home_win),       # Proportion of games won by the home team
    avg_margin   = mean(point_diff),     # Average home − away point differential
    n_games      = n(),                  # Sample size (used to assess reliability)
    .groups = "drop"
  )

# Print the overall home win % and average margin across all seasons
cat(sprintf(
  "Overall home win %%: %.1f%%   |   Avg home margin: +%.2f pts\n",
  mean(df$home_win) * 100,    # Convert proportion to percentage
  mean(df$point_diff)         # Positive value confirms home advantage
))

## Overall home win %: 62.1%   |   Avg home margin: +3.66 pts

# ── Top panel: Home win % ───────────────────────────────────────────────────
p_hca <- ggplot(home_adv, aes(x = season)) +

  # Shaded area between 50 % (coin-flip baseline) and the actual home win %
  geom_ribbon(aes(ymin = 0.5, ymax = home_win_pct),
              fill = "#457B9D", alpha = 0.20) +

  # Actual season-by-season home win % line
  geom_line(aes(y = home_win_pct), colour = "#457B9D", linewidth = 1.1) +

  # Dashed line at 50 % to show where home advantage disappears
  geom_hline(yintercept = 0.5, linetype = "dashed", colour = "grey50") +

  # LOESS trend line to show the long-run decline in home advantage
  geom_smooth(aes(y = home_win_pct), method = "loess", se = FALSE,
              colour = "#E63946", linewidth = 0.9) +

  # Format y-axis as percentages (e.g., 0.60 → "60%")
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     limits = c(0.40, 0.75)) +   # Fix y-axis to meaningful range
  scale_x_continuous(breaks = seq(1950, 2025, 10)) +

  labs(
    title    = "Home Win Percentage by Season",
    subtitle = "Home court advantage has been gradually eroding since its peak in the 1960s–70s",
    x        = NULL,      # Omit x label on top panel (shared with bottom panel)
    y        = "Home Win %"
  ) +
  theme_minimal(base_size = 12)

# ── Bottom panel: Average point margin ─────────────────────────────────────
p_margin <- ggplot(home_adv, aes(x = season, y = avg_margin)) +

  # Colour each bar by whether the home team holds a positive margin
  geom_col(aes(fill = avg_margin > 0), show.legend = FALSE) +

  # Smooth trend line to highlight the erosion in margin over time
  geom_smooth(method = "loess", se = FALSE, colour = "#E63946", linewidth = 0.9) +

  # Blue = home advantage positive; red = below zero (rare in practice)
  scale_fill_manual(values = c("TRUE" = "#457B9D", "FALSE" = "#E63946")) +
  scale_x_continuous(breaks = seq(1950, 2025, 10)) +

  labs(
    title = "Average Point Margin (Home − Away) by Season",
    x     = "Season",
    y     = "Avg Margin"
  ) +
  theme_minimal(base_size = 12)

# Stack the two panels vertically using patchwork
p_hca / p_margin

---

6 The Three-Point Revolution

The 3-point line was introduced in the 1979–80 season, so this section is restricted to 1980 onward.

# Filter to the 3-point era and remove rows where 3PA data is missing
three_pt <- df |>
  filter(season >= 1980,           # Keep only seasons after the 3-point line was introduced
         !is.na(fg3a_home),        # Drop rows where home 3PA is missing
         !is.na(fg3a_away)) |>     # Drop rows where away 3PA is missing
  group_by(season) |>
  summarise(
    avg_3pa_home  = mean(fg3a_home,    na.rm = TRUE),  # Avg 3-point attempts, home team
    avg_3pa_away  = mean(fg3a_away,    na.rm = TRUE),  # Avg 3-point attempts, away team
    avg_3pct_home = mean(fg3_pct_home, na.rm = TRUE),  # Avg 3-point percentage, home team
    avg_3pct_away = mean(fg3_pct_away, na.rm = TRUE),  # Avg 3-point percentage, away team
    .groups = "drop"
  )

# ── 3-Point Attempts Plot ───────────────────────────────────────────────────

# Reshape from wide (two columns) to long (one column with a "team" label)
three_pt |>
  pivot_longer(
    cols      = c(avg_3pa_home, avg_3pa_away),  # Columns to pivot
    names_to  = "team",                          # New column that identifies home vs. away
    values_to = "attempts"                        # New column holding the numeric values
  ) |>
  mutate(team = recode(team,                     # Rename the raw column names to readable labels
                       avg_3pa_home = "Home",
                       avg_3pa_away = "Away")) |>

  ggplot(aes(x = season, y = attempts, colour = team)) +
    geom_line(linewidth = 1.1) +

    # Vertical reference line at the famous 1994–95 rule change
    # (the league temporarily shortened the 3-point arc to boost scoring)
    geom_vline(xintercept = 1995, linetype = "dotted", colour = "grey50") +
    annotate("text", x = 1996, y = 28,
             label = "Arc shortened\n1994–97", size = 3, colour = "grey40", hjust = 0) +

    scale_colour_manual(values = c(Home = "#457B9D", Away = "#2A9D8F")) +
    scale_x_continuous(breaks = seq(1980, 2025, 5)) +

    labs(
      title    = "Avg 3-Point Attempts per Game Since 1980",
      subtitle = "Volume surge accelerated dramatically after ~2013",
      x        = "Season",
      y        = "Avg 3PA per Game",
      colour   = NULL
    ) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top")

# ── 3-Point Percentage Plot ─────────────────────────────────────────────────

three_pt |>
  pivot_longer(
    cols      = c(avg_3pct_home, avg_3pct_away),
    names_to  = "team",
    values_to = "pct"
  ) |>
  mutate(team = recode(team,
                       avg_3pct_home = "Home",
                       avg_3pct_away = "Away")) |>

  ggplot(aes(x = season, y = pct, colour = team)) +
    geom_line(linewidth = 1.1) +

    # Format y-axis as percentages
    scale_y_continuous(labels = percent_format(accuracy = 1)) +
    scale_colour_manual(values = c(Home = "#457B9D", Away = "#2A9D8F")) +
    scale_x_continuous(breaks = seq(1980, 2025, 5)) +

    labs(
      title    = "Avg 3-Point Shooting % per Game Since 1980",
      subtitle = "Accuracy has improved slightly despite far more attempts",
      x        = "Season",
      y        = "Avg 3P%",
      colour   = NULL
    ) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top")

---

7 Shooting Efficiency

# Aggregate home FG% and FT% per season, using the modern stat-tracking era
shooting <- df |>
  filter(season >= 1960,              # Pre-1960 FG% data is unreliable / sparse
         !is.na(fg_pct_home)) |>      # Drop rows with missing FG% (early seasons)
  group_by(season) |>
  summarise(
    fg_pct = mean(fg_pct_home, na.rm = TRUE),  # Average field-goal percentage
    ft_pct = mean(ft_pct_home, na.rm = TRUE),  # Average free-throw percentage
    .groups = "drop"
  )

# Reshape to long format so both metrics can share one ggplot aesthetic
shooting |>
  pivot_longer(
    cols      = -season,         # Pivot every column except 'season'
    names_to  = "metric",        # New column: which shooting metric
    values_to = "pct"            # New column: the percentage value
  ) |>
  mutate(metric = recode(metric,  # Make the labels human-readable
                         fg_pct = "FG%",
                         ft_pct = "FT%")) |>

  ggplot(aes(x = season, y = pct, colour = metric)) +
    geom_line(linewidth = 1.1) +

    # Dashed LOESS smoother per metric to separate short-term noise from trends
    geom_smooth(method = "loess", se = FALSE, linetype = "dashed", linewidth = 0.7) +

    scale_y_continuous(labels = percent_format(accuracy = 1)) +
    scale_colour_manual(values = c("FG%" = "#E63946", "FT%" = "#F4A261")) +
    scale_x_continuous(breaks = seq(1960, 2025, 10)) +

    labs(
      title    = "Home Team FG% and FT% by Season (1960–2023)",
      subtitle = "Field-goal efficiency has climbed steadily; free-throw accuracy is surprisingly flat",
      x        = "Season",
      y        = "Shooting %",
      colour   = NULL
    ) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top")

---

8 Pace & Other Counting Stats

Steals, blocks, turnovers, and assists were not systematically recorded until the 1973–74 season, so this section starts from 1974.

# Compute per-season averages for the main counting-stat categories
pace_era <- df |>
  filter(season >= 1974,          # Restrict to the era where these stats were tracked
         !is.na(tov_home)) |>     # Drop rows where turnover data is missing
  group_by(season) |>
  summarise(
    avg_tov = mean(tov_home, na.rm = TRUE),  # Turnovers committed by the home team
    avg_reb = mean(reb_home, na.rm = TRUE),  # Total rebounds by the home team
    avg_ast = mean(ast_home, na.rm = TRUE),  # Assists by the home team
    avg_stl = mean(stl_home, na.rm = TRUE),  # Steals by the home team
    avg_blk = mean(blk_home, na.rm = TRUE),  # Blocks by the home team
    .groups = "drop"
  )

# ── Individual stat panels, then combined with patchwork ───────────────────

# Turnovers panel
p_tov <- ggplot(pace_era, aes(x = season, y = avg_tov)) +
  geom_line(colour = "#E63946", linewidth = 1.0) +                               # Raw season line
  geom_smooth(method = "loess", se = FALSE, colour = "grey40", linetype = "dashed") +  # Trend
  scale_x_continuous(breaks = seq(1975, 2025, 10)) +
  labs(title = "Turnovers", x = NULL, y = "Avg TOV") +
  theme_minimal(base_size = 11)

# Assists panel
p_ast <- ggplot(pace_era, aes(x = season, y = avg_ast)) +
  geom_line(colour = "#457B9D", linewidth = 1.0) +
  geom_smooth(method = "loess", se = FALSE, colour = "grey40", linetype = "dashed") +
  scale_x_continuous(breaks = seq(1975, 2025, 10)) +
  labs(title = "Assists", x = NULL, y = "Avg AST") +
  theme_minimal(base_size = 11)

# Rebounds panel
p_reb <- ggplot(pace_era, aes(x = season, y = avg_reb)) +
  geom_line(colour = "#2A9D8F", linewidth = 1.0) +
  geom_smooth(method = "loess", se = FALSE, colour = "grey40", linetype = "dashed") +
  scale_x_continuous(breaks = seq(1975, 2025, 10)) +
  labs(title = "Rebounds", x = NULL, y = "Avg REB") +
  theme_minimal(base_size = 11)

# Steals panel
p_stl <- ggplot(pace_era, aes(x = season, y = avg_stl)) +
  geom_line(colour = "#F4A261", linewidth = 1.0) +
  geom_smooth(method = "loess", se = FALSE, colour = "grey40", linetype = "dashed") +
  scale_x_continuous(breaks = seq(1975, 2025, 10)) +
  labs(title = "Steals", x = "Season", y = "Avg STL") +
  theme_minimal(base_size = 11)

# Blocks panel
p_blk <- ggplot(pace_era, aes(x = season, y = avg_blk)) +
  geom_line(colour = "#6A4C93", linewidth = 1.0) +
  geom_smooth(method = "loess", se = FALSE, colour = "grey40", linetype = "dashed") +
  scale_x_continuous(breaks = seq(1975, 2025, 10)) +
  labs(title = "Blocks", x = "Season", y = "Avg BLK") +
  theme_minimal(base_size = 11)

# Arrange all five panels in a 2-column grid using patchwork
(p_tov | p_ast) /    # First row: turnovers and assists side by side
(p_reb | p_stl) /    # Second row: rebounds and steals side by side
(p_blk | plot_spacer()) +   # Third row: blocks on left; empty spacer on right

# Add a shared title and caption for the combined figure
plot_annotation(
  title   = "Home Team Counting Stats by Season (1974–2023)",
  caption = "Dashed lines = LOESS trend"
)

---

9 Score Margin Distribution

# Compute the overall mean margin once so it can be reused in annotations
mean_margin <- mean(df$point_diff)   # Scalar: average home − away differential

df |>
  filter(season >= 1980) |>    # Restrict to the modern era for cleaner stats

  ggplot(aes(x = point_diff)) +

    # Histogram with 2-point bins; colour = "white" adds thin separating lines
    geom_histogram(binwidth = 2, fill = "#457B9D", colour = "white", alpha = 0.85) +

    # Vertical line at zero = perfectly even game
    geom_vline(xintercept = 0,           linetype = "dashed", colour = "grey40") +

    # Vertical line at the mean shows the typical home advantage
    geom_vline(xintercept = mean_margin, linetype = "solid",  colour = "#E63946", linewidth = 1) +

    # Text label for the mean line; hjust = 0 left-aligns text from the line's x position
    annotate("text",
             x     = mean_margin + 2,   # Nudge the label slightly to the right of the line
             y     = 2200,              # Place label near the top of the histogram
             label = sprintf("Mean = +%.1f", mean_margin),  # e.g., "Mean = +3.7"
             colour = "#E63946",
             size   = 3.8,
             hjust  = 0) +

    labs(
      title    = "Distribution of Point Margin (Home − Away), 1980–Present",
      subtitle = "Right-skewed: home teams win more often and by larger margins on average",
      x        = "Point Differential (Home − Away)",
      y        = "Number of Games"
    ) +
    theme_minimal(base_size = 12)

---

10 Correlation Matrix

Which box-score stats have the strongest relationship with winning margin? This section uses 1985–present so all advanced stats are available.

# Select the variables to include in the correlation analysis
corr_vars <- c(
  "pts_home",      # Points scored (the direct outcome)
  "fg_pct_home",   # Field-goal efficiency
  "fg3m_home",     # Three-pointers made
  "ftm_home",      # Free throws made
  "reb_home",      # Total rebounds
  "ast_home",      # Assists
  "stl_home",      # Steals
  "blk_home",      # Blocks
  "tov_home",      # Turnovers (negative factor)
  "pf_home",       # Personal fouls
  "point_diff"     # Winning margin (target variable)
)

# Build the correlation data frame: modern era, complete cases only
corr_df <- df |>
  filter(season >= 1985) |>          # Restrict to era with reliable advanced stats
  select(all_of(corr_vars)) |>       # Keep only the selected variables
  drop_na()                           # Remove any remaining rows with missing values

# Compute the Pearson correlation matrix (returns a square matrix)
corr_matrix <- cor(corr_df)

# corrplot doesn't use ggplot; use par() to add a margin for the title
par(mar = c(0, 0, 2, 0))   # Set plot margins: bottom, left, top, right (in lines)

corrplot(
  corr_matrix,
  method      = "color",       # Fill cells with a colour gradient (not circles or numbers only)
  type        = "upper",       # Show only the upper triangle (matrix is symmetric)
  addCoef.col = "black",       # Print correlation coefficients in black text
  number.cex  = 0.65,          # Shrink coefficient text so it fits in each cell
  tl.cex      = 0.85,          # Size of variable name labels along the axes
  tl.col      = "black",       # Colour of variable name labels
  col         = colorRampPalette(   # Custom red–white–blue diverging colour palette
    c("#E63946", "white", "#457B9D"))(200),   # 200 colour steps for smooth gradient
  title       = "Correlation Matrix — Home Team Stats (1985–2023)",
  mar         = c(0, 0, 2, 0)  # Re-state margin inside corrplot (needed for title spacing)
)

---

11 Franchise Rankings

11.1 Home Win % (2000–2023)

# Compute per-franchise home-game performance over the modern era
team_stats <- df |>
  filter(season >= 2000) |>     # Group only by abbreviation to prevent duplicate rows from teams that changed their name
  group_by(team_abbreviation_home) |>                      # Carry the full name along
  summarise(
    games        = n(),                            # Total home games played
    home_wins    = sum(home_win),                  # Total home wins
    home_win_pct = mean(home_win),                 # Home win proportion
    avg_pts      = mean(pts_home),                 # Average home points scored
    avg_margin   = mean(point_diff),               # Average home point differential
    .groups = "drop"
  ) |>
  filter(games >= 200) |>    # Exclude franchises with too few games (relocated/expansion teams)
  arrange(desc(home_win_pct))  # Sort best-to-worst

# Display the top 10 home teams as a styled table
team_stats |>
  head(10) |>                                              # Keep top 10 rows
  mutate(
    home_win_pct = percent(home_win_pct, accuracy = 0.1),  # Format as "63.4%"
    avg_pts      = round(avg_pts, 1),                       # Round to 1 decimal
    avg_margin   = round(avg_margin, 2)                     # Round to 2 decimals
  ) |>
kbl(caption = "Top 10 Franchises by Home Win % (2000–2023, ≥ 200 games)",
    col.names = c("Abbr.", "Games", "Wins", "Win %", "Avg Pts", "Avg Margin")) |>
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE)

Top 10 Franchises by Home Win % (2000–2023, ≥ 200 games)

Abbr.	Games	Wins	Win %	Avg Pts	Avg Margin
SAS	874	652	74.6%	103.7	7.64
DAL	880	609	69.2%	105.5	5.66
UTA	875	581	66.4%	102.9	5.60
DEN	879	581	66.1%	106.7	4.88
MIA	878	564	64.2%	100.8	4.00
BOS	876	553	63.1%	102.5	4.37
LAL	875	551	63.0%	105.1	3.94
OKC	550	346	62.9%	107.8	4.26
IND	878	552	62.9%	102.5	4.23
POR	875	544	62.2%	103.3	3.47

# Sort the data by win percentage first, then convert to factor in that order
plot_data <- team_stats |>
  group_by(team_abbreviation_home) |>                          # Ensure one row per abbreviation
  summarise(home_win_pct = mean(home_win_pct), .groups = "drop") |>   # Collapse to one row
  arrange(home_win_pct) |>                                     # Sort rows low to high
  mutate(team_abbreviation_home = factor(                      # Convert to factor AFTER sorting
    team_abbreviation_home,                                    # Use the column values
    levels = unique(team_abbreviation_home)                    # Lock in the sorted order as levels
  ))

# Build the plot using the pre-sorted data
ggplot(plot_data, aes(y = team_abbreviation_home,
                      x = home_win_pct,
                      fill = home_win_pct)) +
  geom_col(show.legend = FALSE) +
  geom_vline(xintercept = 0.5, linetype = "dashed", colour = "grey40") +
  scale_x_continuous(labels = percent_format(accuracy = 1), limits = c(0, 1)) +
  scale_fill_gradient2(
    low      = "#E63946",
    mid      = "grey85",
    high     = "#457B9D",
    midpoint = 0.5
  ) +
  labs(
    title    = "Home Win % by Franchise (2000–2023)",
    subtitle = "Minimum 200 home games • Dashed line = 50% break-even",
    x        = "Home Win %",
    y        = NULL
  ) +
  theme_minimal(base_size = 10) +
  theme(panel.grid.major.y = element_blank())

---

# Check which teams have NA or unexpected values in wl_home
df |>
  filter(season >= 2000) |>
  group_by(team_abbreviation_home) |>
  summarise(
    total_games    = n(),
    na_wl_count    = sum(is.na(wl_home)),       # Count rows where wl_home is NA
    unexpected_val = sum(!wl_home %in% c("W", "L"), na.rm = TRUE)  # Count values that aren't W or L
  ) |>
  filter(na_wl_count > 0 | unexpected_val > 0)  # Show only the problem teams

12 Blowouts vs. Close Games

# Classify each game and compute proportions per season
blowout <- df |>
  group_by(season) |>
  summarise(
    blowout_pct = mean(abs(point_diff) >= 20),   # % of games decided by 20+ points
    close_pct   = mean(abs(point_diff) <= 5),    # % of games decided by 5 or fewer points
    .groups = "drop"
  )

blowout |>
  # Pivot both proportions into a single column for easy ggplot colouring
  pivot_longer(
    cols      = -season,
    names_to  = "type",
    values_to = "pct"
  ) |>
  mutate(type = recode(type,
                       blowout_pct = "Blowout (≥ 20 pts)",
                       close_pct   = "Close Game (≤ 5 pts)")) |>

  ggplot(aes(x = season, y = pct, colour = type)) +
    geom_line(linewidth = 1.1) +

    # LOESS smoother per series to reveal long-run trends
    geom_smooth(method = "loess", se = FALSE,
                linetype = "dashed", linewidth = 0.7) +

    scale_y_continuous(labels = percent_format(accuracy = 1)) +
    scale_colour_manual(values = c(
      "Blowout (≥ 20 pts)"  = "#E63946",
      "Close Game (≤ 5 pts)" = "#457B9D"
    )) +
    scale_x_continuous(breaks = seq(1950, 2025, 10)) +

    labs(
      title    = "% Blowouts vs. Close Games by Season",
      subtitle = "Blowouts have risen sharply in the post-2010 era; close games have declined",
      x        = "Season",
      y        = "% of Games",
      colour   = NULL
    ) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top")

---

13 Summary Statistics

# Compute a concise set of headline numbers across the full dataset
summary_tbl <- df |>
  summarise(
    `Total Games`              = format(n(), big.mark = ","),                  # Formatted row count
    `Seasons Covered`          = n_distinct(season),                           # Unique season count
    `First Season`             = min(season),                                  # Earliest season year
    `Last Season`              = max(season),                                  # Latest season year
    `Home Win %`               = percent(mean(home_win), accuracy = 0.1),     # Overall HCA rate
    `Avg Home Points`          = round(mean(pts_home), 1),                    # Mean home score
    `Avg Away Points`          = round(mean(pts_away), 1),                    # Mean away score
    `Avg Combined Score`       = round(mean(total_pts), 1),                   # Mean total pts
    `Avg Home Margin`          = round(mean(point_diff), 2),                  # Mean home-team edge
    `Highest-Scoring Game`     = max(total_pts),                              # Maximum combined score
    `% Blowouts (≥ 20 pts)`    = percent(mean(abs(point_diff) >= 20), 0.1),  # Share of blowouts
    `% Close Games (≤ 5 pts)`  = percent(mean(abs(point_diff) <=  5), 0.1)   # Share of nail-biters
  )

# Transpose: one row per metric for a vertical summary layout
summary_tbl |>
  mutate(across(everything(), as.character)) |>   # Convert every column to character so they can be combined into one column
  pivot_longer(
    everything(),                # Pivot every column
    names_to  = "Metric",        # Column names become row labels
    values_to = "Value"          # Values move into a single column
  ) |>
  kbl(caption = "High-Level Summary — Full Dataset (1946–2023)") |>
  kable_styling(
    bootstrap_options = c("striped", "hover"),
    full_width = FALSE,
    position   = "left"
  )

High-Level Summary — Full Dataset (1946–2023)

Metric	Value
Total Games	62,354
Seasons Covered	75
First Season	1946
Last Season	2022
Home Win %	62.1%
Avg Home Points	104.9
Avg Away Points	101.3
Avg Combined Score	206.2
Avg Home Margin	3.66
Highest-Scoring Game	370
% Blowouts (≥ 20 pts)	14.2%
% Close Games (≤ 5 pts)	29.3%

---

Report generated with R 4.5.2 and rmarkdown on 2026-03-09.