cluster-analysis.qmd

# Cluster Analysis {#sec-clusterAnalysis}

## Getting Started {#sec-clusterAnalysisGettingStarted}

### Load Packages {#sec-clusterAnalysisLoadPackages}

```{r}
library("petersenlab")
library("nflreadr")
library("mclust")
library("plotly")
library("tidyverse")
```

### Load Data {#sec-clusterAnalysisLoadData}

```{r}
#| eval: false
#| include: false

load(file = "./data/nfl_players.RData")
load(file = "./data/nfl_combine.RData")
load(file = file.path(path, "/OneDrive - University of Iowa/Teaching/Courses/Fantasy Football/Data/player_stats_weekly.RData", fsep = ""))
load(file = file.path(path, "/OneDrive - University of Iowa/Teaching/Courses/Fantasy Football/Data/player_stats_seasonal.RData", fsep = ""))
load(file = "./data/nfl_advancedStatsPFR_seasonal.RData")
load(file = "./data/nfl_actualStats_career.RData")
```

```{r}
load(file = "./data/nfl_players.RData")
load(file = "./data/nfl_combine.RData")
load(file = "./data/player_stats_weekly.RData")
load(file = "./data/player_stats_seasonal.RData")
load(file = "./data/nfl_advancedStatsPFR_seasonal.RData")
load(file = "./data/nfl_actualStats_career.RData")
```

### Overview {#sec-clusterAnalysisOverview}

Whereas [factor analysis](#sec-factorAnalysis) evaluates how *variables* do or do not hang together—in terms of their associations and non-associations, cluster analysis evaluates how *people* are or or not similar—in terms of their scores on one or more variables.
The goal of cluster analysis is to identify distinguishable subgroups of people.
The people within a subgroup are expected to be more similar to each other than they are to people in other subgroups.
For instance, we might expect that there are distinguishable subtypes of Wide Receivers: possession, deep threats, and slot-type Wide Receivers.
Possession Wide Receivers tend to be taller and heavier, with good hands who catch the ball at a high rate.
Deep threat Wide Receivers tend to be fast.
Slot-type Wide Receivers tend to be small, quick, and agile.
In order to identify these clusters of Wide Receivers, we might conduct a cluster analysis with variables relating to the players' height, weight, percent of (catchable) targets caught, air yards received, and various metrics from the National Football League (NFL) Combine, including their times in the 40-yard dash, 20-yard shuttle run, and three cone drill.

There are many approaches to cluster analysis, including model-based clustering, density-based clustering, centroid-based clustering, hierarchical clustering (aka connectivity-based clustering), etc.
An overview of approaches to cluster analysis in `R` is provided by @Kassambara2017a.
In this chapter, we focus on examples using model-based clustering with the `mclust` package [@Scrucca2023], which uses Gaussian finite mixture modeling.
The various types of `mclust` models are provided here:
<https://mclust-org.github.io/mclust/reference/mclustModelNames.html>.

### Tiers of Prior Season Fantasy Points {#sec-clusterAnalysisExample}

#### Prepare Data {#sec-clusterAnalysisExamplePrepareData}

```{r}
recentSeason <- max(player_stats_seasonal$season, na.rm = TRUE) # also works: nflreadr::most_recent_season()
recentSeason

player_stats_seasonal_offense_recent <- player_stats_seasonal %>% 
  filter(season == recentSeason) %>% 
  filter(position_group %in% c("QB","RB","WR","TE"))

player_stats_seasonal_offense_recentQB <- player_stats_seasonal_offense_recent %>% 
  filter(position_group == "QB")

player_stats_seasonal_offense_recentRB <- player_stats_seasonal_offense_recent %>% 
  filter(position_group == "RB")

player_stats_seasonal_offense_recentWR <- player_stats_seasonal_offense_recent %>% 
  filter(position_group == "WR")

player_stats_seasonal_offense_recentTE <- player_stats_seasonal_offense_recent %>% 
  filter(position_group == "TE")
```

#### Identify the Optimal Number of Tiers by Position {#sec-clusterAnalysisExampleNumTiers}

##### Quarterbacks {#sec-clusterAnalysisExampleNumTiersQBs}

```{r}
tiersQB_bic <- mclust::mclustBIC(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
  G = 1:9
)

tiersQB_bic
summary(tiersQB_bic)
plot(tiersQB_bic)

tiersQB_icl <- mclust::mclustICL(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
  G = 1:9
)

tiersQB_icl
summary(tiersQB_icl)
plot(tiersQB_icl)

tiersQB_boostrap <- mclust::mclustBootstrapLRT(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
  modelName = "V") # variable/unequal variance (for univariate data)

numTiersQB <- as.numeric(summary(tiersQB_boostrap)[,"Length"][1]) # or could specify the number of teams manually

tiersQB_boostrap
plot(
  tiersQB_boostrap,
  G = numTiersQB - 1)
```

##### Running Backs {#sec-clusterAnalysisExampleNumTiersRBs}

```{r}
tiersRB_bic <- mclust::mclustBIC(
  data = player_stats_seasonal_offense_recentRB$fantasyPoints,
  G = 1:9
)

tiersRB_bic
summary(tiersRB_bic)
plot(tiersRB_bic)

tiersRB_icl <- mclust::mclustICL(
  data = player_stats_seasonal_offense_recentRB$fantasyPoints,
  G = 1:9
)

tiersRB_icl
summary(tiersRB_icl)
plot(tiersRB_icl)

numTiersRB <- 3
```

The model-based bootstrap clustering of Running Backs' fantasy points is unable to run due to an error:

```{r}
tiersRB_boostrap <- mclust::mclustBootstrapLRT(
  data = player_stats_seasonal_offense_recentRB$fantasyPoints,
  modelName = "V") # variable/unequal variance (for univariate data)
```

Thus, we cannot use the following code, which would otherwise summarize the model results, specify the number of tiers, and plot model comparisons:

```{r}
#| eval: false

numTiersRB <- as.numeric(summary(tiersRB_boostrap)[,"Length"][1]) # or could specify the number of teams manually

tiersRB_boostrap
plot(
  tiersRB_boostrap,
  G = numTiersRB - 1)
```

##### Wide Receivers {#sec-clusterAnalysisExampleNumTiersWRs}

```{r}
tiersWR_bic <- mclust::mclustBIC(
  data = player_stats_seasonal_offense_recentWR$fantasyPoints,
  G = 1:9
)

tiersWR_bic
summary(tiersWR_bic)
plot(tiersWR_bic)

tiersWR_icl <- mclust::mclustICL(
  data = player_stats_seasonal_offense_recentWR$fantasyPoints,
  G = 1:9
)

tiersWR_icl
summary(tiersWR_icl)
plot(tiersWR_icl)

tiersWR_boostrap <- mclust::mclustBootstrapLRT(
  data = player_stats_seasonal_offense_recentWR$fantasyPoints,
  modelName = "V") # variable/unequal variance (for univariate data)

numTiersWR <- as.numeric(summary(tiersWR_boostrap)[,"Length"][1]) # or could specify the number of teams manually

tiersWR_boostrap
plot(
  tiersWR_boostrap,
  G = numTiersWR - 1)
```

##### Tight Ends {#sec-clusterAnalysisExampleNumTiersTEs}

```{r}
tiersTE_bic <- mclust::mclustBIC(
  data = player_stats_seasonal_offense_recentTE$fantasyPoints,
  G = 1:9
)

tiersTE_bic
summary(tiersTE_bic)
plot(tiersTE_bic)

tiersTE_icl <- mclust::mclustICL(
  data = player_stats_seasonal_offense_recentTE$fantasyPoints,
  G = 1:9
)

tiersTE_icl
summary(tiersTE_icl)
plot(tiersTE_icl)

tiersTE_boostrap <- mclust::mclustBootstrapLRT(
  data = player_stats_seasonal_offense_recentTE$fantasyPoints,
  modelName = "V") # variable/unequal variance (for univariate data)

numTiersTE <- as.numeric(summary(tiersTE_boostrap)[,"Length"][1]) # or could specify the number of teams manually

tiersTE_boostrap
plot(
  tiersTE_boostrap,
  G = numTiersTE - 1)
```

#### Fit the Cluster Model to the Optimal Number of Tiers {#sec-clusterAnalysisExampleModel}

##### Quarterbacks {#sec-clusterAnalysisExampleModelQBs}

In our data, all of the following models are equivalent—i.e., they result in the same unequal variance model with a 4-cluster solution—but they arrive there in different ways.

```{r}
#| eval: false

mclust::Mclust(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
  G = numTiersQB,
)

mclust::Mclust(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
  G = 4,
)

mclust::Mclust(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
)

mclust::Mclust(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
  x = tiersQB_bic
)
```

Let's fit one of these:

```{r}
clusterModelQBs <- mclust::Mclust(
  data = player_stats_seasonal_offense_recentQB$fantasyPoints,
  G = numTiersQB,
)
```

Here are the number of players that are in each of the four clusters (i.e., tiers):

```{r}
table(clusterModelQBs$classification)
```

##### Running Backs {#sec-clusterAnalysisExampleModelRBs}

```{r}
clusterModelRBs <- mclust::Mclust(
  data = player_stats_seasonal_offense_recentRB$fantasyPoints,
  G = numTiersRB,
)
```

Here are the number of players that are in each of the four clusters (i.e., tiers):

```{r}
table(clusterModelRBs$classification)
```

##### Wide Receivers {#sec-clusterAnalysisExampleModelWRs}

```{r}
clusterModelWRs <- mclust::Mclust(
  data = player_stats_seasonal_offense_recentWR$fantasyPoints,
  G = numTiersWR,
)
```

Here are the number of players that are in each of the four clusters (i.e., tiers):

```{r}
table(clusterModelWRs$classification)
```

##### Tight Ends {#sec-clusterAnalysisExampleModelTEs}

```{r}
clusterModelTEs <- mclust::Mclust(
  data = player_stats_seasonal_offense_recentTE$fantasyPoints,
  G = numTiersTE,
)
```

Here are the number of players that are in each of the four clusters (i.e., tiers):

```{r}
table(clusterModelTEs$classification)
```

#### Plot the Tiers {#sec-clusterAnalysisExamplePlotTiers}

We can merge the player's classification into the dataset and plot each player's classification.

##### Quarterbacks {#sec-clusterAnalysisExamplePlotTiersQB}

```{r}
#| label: fig-qbTiers
#| fig-cap: "Quarterback Fantasy Points by Tier."
#| fig-alt: "Quarterback Fantasy Points by Tier."

player_stats_seasonal_offense_recentQB$tier <- clusterModelQBs$classification

player_stats_seasonal_offense_recentQB <- player_stats_seasonal_offense_recentQB %>%
  mutate(
    tier = factor(max(tier, na.rm = TRUE) + 1 - tier)
  )

player_stats_seasonal_offense_recentQB$position_rank <- rank(
  player_stats_seasonal_offense_recentQB$fantasyPoints * -1,
  na.last = "keep",
  ties.method = "min")

plot_qbTiers <- ggplot2::ggplot(
  data = player_stats_seasonal_offense_recentQB,
  mapping = aes(
    x = fantasyPoints,
    y = position_rank,
    color = tier
  )) +
  geom_point(
    aes(
      text = player_display_name # add player name for mouse over tooltip
  )) +
  scale_y_continuous(trans = "reverse") +
  coord_cartesian(clip = "off") +
  labs(
    x = "Projected Points",
    y = "Position Rank",
    title = "Quarterback Fantasy Points by Tier",
    color = "Tier") +
  theme_classic() +
  theme(legend.position = "top")

ggplotly(plot_qbTiers)
```

##### Running Backs {#sec-clusterAnalysisExamplePlotTiersRBs}

```{r}
#| label: fig-rbTiers
#| fig-cap: "Running Back Fantasy Points by Tier."
#| fig-alt: "Running Back Fantasy Points by Tier."

player_stats_seasonal_offense_recentRB$tier <- clusterModelRBs$classification

player_stats_seasonal_offense_recentRB <- player_stats_seasonal_offense_recentRB %>%
  mutate(
    tier = factor(max(tier, na.rm = TRUE) + 1 - tier)
  )

player_stats_seasonal_offense_recentRB$position_rank <- rank(
  player_stats_seasonal_offense_recentRB$fantasyPoints * -1,
  na.last = "keep",
  ties.method = "min")

plot_rbTiers <- ggplot2::ggplot(
  data = player_stats_seasonal_offense_recentRB,
  mapping = aes(
    x = fantasyPoints,
    y = position_rank,
    color = tier
  )) +
  geom_point(
    aes(
      text = player_display_name # add player name for mouse over tooltip
  )) +
  scale_y_continuous(trans = "reverse") +
  coord_cartesian(clip = "off") +
  labs(
    x = "Projected Points",
    y = "Position Rank",
    title = "Running Back Fantasy Points by Tier",
    color = "Tier") +
  theme_classic() +
  theme(legend.position = "top")

ggplotly(plot_rbTiers)
```

##### Wide Receivers {#sec-clusterAnalysisExamplePlotTiersWRs}

```{r}
#| label: fig-wrTiers
#| fig-cap: "Quarterback Fantasy Points by Tier."
#| fig-alt: "Quarterback Fantasy Points by Tier."

player_stats_seasonal_offense_recentWR$tier <- clusterModelWRs$classification

player_stats_seasonal_offense_recentWR <- player_stats_seasonal_offense_recentWR %>%
  mutate(
    tier = factor(max(tier, na.rm = TRUE) + 1 - tier)
  )

player_stats_seasonal_offense_recentWR$position_rank <- rank(
  player_stats_seasonal_offense_recentWR$fantasyPoints * -1,
  na.last = "keep",
  ties.method = "min")

plot_wrTiers <- ggplot2::ggplot(
  data = player_stats_seasonal_offense_recentWR,
  mapping = aes(
    x = fantasyPoints,
    y = position_rank,
    color = tier
  )) +
  geom_point(
    aes(
      text = player_display_name # add player name for mouse over tooltip
  )) +
  scale_y_continuous(trans = "reverse") +
  coord_cartesian(clip = "off") +
  labs(
    x = "Projected Points",
    y = "Position Rank",
    title = "Wide Receiver Fantasy Points by Tier",
    color = "Tier") +
  theme_classic() +
  theme(legend.position = "top")

ggplotly(plot_wrTiers)
```

##### Tight Ends {#sec-clusterAnalysisExamplePlotTiersTEs}

```{r}
#| label: fig-teTiers
#| fig-cap: "Tight End Fantasy Points by Tier."
#| fig-alt: "Tight End Fantasy Points by Tier."

player_stats_seasonal_offense_recentTE$tier <- clusterModelTEs$classification

player_stats_seasonal_offense_recentTE <- player_stats_seasonal_offense_recentTE %>%
  mutate(
    tier = factor(max(tier, na.rm = TRUE) + 1 - tier)
  )

player_stats_seasonal_offense_recentTE$position_rank <- rank(
  player_stats_seasonal_offense_recentTE$fantasyPoints * -1,
  na.last = "keep",
  ties.method = "min")

plot_teTiers <- ggplot2::ggplot(
  data = player_stats_seasonal_offense_recentTE,
  mapping = aes(
    x = fantasyPoints,
    y = position_rank,
    color = tier
  )) +
  geom_point(
    aes(
      text = player_display_name # add player name for mouse over tooltip
  )) +
  scale_y_continuous(trans = "reverse") +
  coord_cartesian(clip = "off") +
  labs(
    x = "Projected Points",
    y = "Position Rank",
    title = "Tight End Fantasy Points by Tier",
    color = "Tier") +
  theme_classic() +
  theme(legend.position = "top")

ggplotly(plot_teTiers)
```

### Types of Wide Receivers {#sec-clusterAnalysisWRtypes}

```{r}
#| eval: false
#| include: false

#names(nfl_players) #gsis_id: height, weight
#names(nfl_combine) #gsis_id: vertical, forty, ht, wt
#names(player_stats_seasonal_offense) #player_id, season: receptions, receiving_air_yards, air_yards_share, target_share
#names(nfl_advancedStatsPFR_seasonal) #gsis_id, season: adot.rec, rec.rec, brk_tkl.rec, drop.rec, drop_percent.rec
#names(nfl_actualStats_offense_career) #player_id: receptions, targets, receiving_air_yards, air_yards_share, target_share
```

```{r}
# Compute Advanced PFR Stats by Career
pfrVars <- nfl_advancedStatsPFR_seasonal %>% 
  select(pocket_time.pass:cmp_percent.def, g, gs) %>% 
  names()

weightedAverageVars <- c(
  "pocket_time.pass",
  "ybc_att.rush","yac_att.rush",
  "ybc_r.rec","yac_r.rec","adot.rec","rat.rec",
  "yds_cmp.def","yds_tgt.def","dadot.def","m_tkl_percent.def","rat.def"
)

recomputeVars <- c(
  "drop_pct.pass", # drops.pass / pass_attempts.pass
  "bad_throw_pct.pass", # bad_throws.pass / pass_attempts.pass
  "on_tgt_pct.pass", # on_tgt_throws.pass / pass_attempts.pass
  "pressure_pct.pass", # times_pressured.pass / pass_attempts.pass
  "drop_percent.rec", # drop.rec / tgt.rec
  "rec_br.rec", # rec.rec / brk_tkl.rec
  "cmp_percent.def" # cmp.def / tgt.def
)

sumVars <- pfrVars[pfrVars %ni% c(
  weightedAverageVars, recomputeVars,
  "merge_name", "loaded.pass", "loaded.rush", "loaded.rec", "loaded.def")]

nfl_advancedStatsPFR_career <- nfl_advancedStatsPFR_seasonal %>% 
  group_by(pfr_id, merge_name) %>% 
  summarise(
    across(all_of(weightedAverageVars), ~ weighted.mean(.x, w = g, na.rm = TRUE)),
    across(all_of(sumVars), ~ sum(.x, na.rm = TRUE)),
    .groups = "drop") %>% 
  mutate(
    drop_pct.pass = drops.pass / pass_attempts.pass,
    bad_throw_pct.pass = bad_throws.pass / pass_attempts.pass,
    on_tgt_pct.pass = on_tgt_throws.pass / pass_attempts.pass,
    pressure_pct.pass = times_pressured.pass / pass_attempts.pass,
    drop_percent.rec = drop.rec / tgt.rec,
    rec_br.rec = drop.rec / tgt.rec,
    cmp_percent.def = cmp.def / tgt.def
  )

uniqueCases <- nfl_advancedStatsPFR_seasonal %>% select(pfr_id, merge_name, gsis_id) %>% unique()

uniqueCases %>%
  group_by(pfr_id) %>% 
  filter(n() > 1)

nfl_advancedStatsPFR_seasonal <- nfl_advancedStatsPFR_seasonal %>% 
  filter(pfr_id != "WillMa06" | merge_name != "MARCUSWILLIAMS" | !is.na(gsis_id))


nfl_advancedStatsPFR_career <- left_join(
  nfl_advancedStatsPFR_career,
  nfl_advancedStatsPFR_seasonal %>% select(pfr_id, merge_name, gsis_id) %>% unique(),
  by = c("pfr_id", "merge_name")
)

# Compute Player Stats Per Season
player_stats_seasonal_careerWRs <- player_stats_seasonal %>% 
  filter(position == "WR") %>% 
  group_by(player_id) %>% 
  summarise(
    across(all_of(c("targets", "receptions", "receiving_air_yards")), ~ weighted.mean(.x, w = games, na.rm = TRUE)),
    .groups = "drop")

# Drop players with no receiving air yards
player_stats_seasonal_careerWRs <- player_stats_seasonal_careerWRs %>% 
  filter(receiving_air_yards != 0) %>% 
  rename(
    targets_per_season = targets,
    receptions_per_season = receptions,
    receiving_air_yards_per_season = receiving_air_yards
  )

# Merge
playerListToMerge <- list(
  nfl_players %>% select(gsis_id, display_name, position, height, weight),
  nfl_combine %>% select(gsis_id, vertical, forty, ht, wt),
  player_stats_seasonal_careerWRs %>% select(player_id, targets_per_season, receptions_per_season, receiving_air_yards_per_season) %>% 
    rename(gsis_id = player_id),
  nfl_actualStats_offense_career %>% select(player_id, receptions, targets, receiving_air_yards, air_yards_share, target_share) %>% 
    rename(gsis_id = player_id),
  nfl_advancedStatsPFR_career %>% select(gsis_id, adot.rec, rec.rec, brk_tkl.rec, drop.rec, drop_percent.rec)
)

merged_data <- playerListToMerge %>% 
  reduce(
    full_join,
    by = c("gsis_id"),
    na_matches = "never")
```

Additional processing:

```{r}
merged_data <- merged_data %>% 
  mutate(
    height_coalesced = coalesce(height, ht),
    weight_coalesced = coalesce(weight, wt),
    receptions_coalesced = pmax(receptions, rec.rec, na.rm = TRUE),
    receiving_air_yards_per_rec = receiving_air_yards / receptions
  )

merged_data$receiving_air_yards_per_rec[which(merged_data$receptions == 0)] <- 0

merged_dataWRs <- merged_data %>% 
  filter(position == "WR")

merged_dataWRs_cluster <- merged_dataWRs %>% 
  filter(receptions_coalesced >= 100) %>% # keep WRs with at least 100 receptions
  select(gsis_id, display_name, vertical, forty, height_coalesced, weight_coalesced, adot.rec, drop_percent.rec, receiving_air_yards_per_rec, brk_tkl.rec, receptions_per_season) %>% #targets_per_season, receiving_air_yards_per_season, air_yards_share, target_share
  na.omit()
```

#### Identify the Number of WR Types {#sec-clusterAnalysisNumWRtypes}

```{r}
wrTypes_bic <- mclust::mclustBIC(
  data = merged_dataWRs_cluster %>% select(-gsis_id, -display_name),
  G = 1:9
)

wrTypes_bic
summary(wrTypes_bic)
plot(wrTypes_bic)

wrTypes_icl <- mclust::mclustICL(
  data = merged_dataWRs_cluster %>% select(-gsis_id, -display_name),
  G = 1:9
)

wrTypes_icl
summary(wrTypes_icl)
plot(wrTypes_icl)
```

Based on the cluster analyses, it appears that three clusters are the best fit to the data.

```{r}
numTypesWR <- 3
```

```{r}
#| eval: false

wrTypes_boostrap <- mclust::mclustBootstrapLRT(
  data = merged_dataWRs_cluster %>% select(-gsis_id, -display_name),
  modelName = "EVE") # ellipsoidal with equal volume, variable shape, and equal orientation (for multivariate data)

wrTypes_boostrap
plot(
  wrTypes_boostrap,
  G = numTypesWR - 1)
```

#### Fit the Cluster Model to the Optimal Number of WR Types {#sec-clusterAnalysisModelWRtypes}

```{r}
clusterModelWRtypes <- mclust::Mclust(
  data = merged_dataWRs_cluster %>% select(-gsis_id, -display_name),
  G = numTypesWR,
)

summary(clusterModelWRtypes)
```

#### Plots of the Cluster Model {#sec-clusterAnalysisPlotsWRtypes}

```{r}
plot(
  clusterModelWRtypes,
  what = "BIC")
```

```{r}
plot(
  clusterModelWRtypes,
  what = "classification")
```

```{r}
plot(
  clusterModelWRtypes,
  what = "uncertainty")
```

```{r}
plot(
  clusterModelWRtypes,
  what = "density")
```

#### Interpreting the Clusters {#sec-clusterAnalysisInterpretationWRtypes}

```{r}
table(clusterModelWRtypes$classification)

merged_dataWRs_cluster$type <- clusterModelWRtypes$classification

merged_dataWRs_cluster %>% 
  group_by(type) %>% 
  summarise(across(
    where(is.numeric),
    ~ mean(., na.rm = TRUE)
    )) %>% 
  t() %>% 
  round(., 2)
```

Based on this analysis (and the variables included), there appear to be three types of Wide Receivers.
Type 1 Wide Receivers includes the Elite WR1s who are strong possession receivers (note: not all players in a given cluster map on perfectly to the typology—i.e., not all Type 1 Wide Receivers are elite WR1s).
They tend to have the lowest drop percentage, the shortest average depth of target, and the fewest receiving air yards per reception.
They tend to have the most receptions per season and break the most tackles.

Type 2 Wide Receivers includes the consistent contributor, WR2 types.
They had fewer receptions and fewer broken tackles than Type 1 Wide Receivers.
Their average depth of target was longer than Type 1, and they had more receiving air yards per reception than Type 1.

Type 3 Wide Receivers includes the deep threats.
They have the greatest average depth of target and the most receiving yards per reception.
However, they also have the fewest receptions, the highest drop percentage, and the fewest broken tackles.
Thus, they may be considered the boom-or-bust Wide Receivers.

The tiers were not particularly distinguishable based on their height, weight, vertical jump, or forty-yard dash time.

Type 1 ("Elite/WR1") WRs:

```{r}
merged_dataWRs_cluster %>% 
  filter(type == 1) %>% 
  select(display_name)
```

Type 2 ("Consistent Contributor/WR2") WRs:

```{r}
merged_dataWRs_cluster %>% 
  filter(type == 2) %>% 
  select(display_name)
```

Type 3 ("Deep Threat/Boom-or-Bust") WRs:

```{r}
merged_dataWRs_cluster %>% 
  filter(type == 3) %>% 
  select(display_name)
```

## Conclusion {#sec-clusterAnalysisConclusion}

::: {.content-visible when-format="html"}

## Session Info {#sec-clusterAnalysisSessionInfo}

```{r}
sessionInfo()
```

:::