library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(cfbfastR)
library(DT)
## Warning: package 'DT' was built under R version 4.4.3
WR_Stats <- read.csv("WR_Rankings.csv") %>%
arrange(rank) %>%
mutate(pos_rank_bef = row_number())
datatable(WR_Stats)
pbp_2024 <- load_cfb_pbp(seasons = 2024)
wr_players <- WR_Stats$player
wr_players
## [1] "Travis Hunter" "Tetairoa McMillan" "Luther Burden III"
## [4] "Emeka Egbuka" "Matthew Golden" "Elic Ayomanor"
## [7] "Jack Bech" "Jayden Higgins" "Xavier Restrepo"
## [10] "Tre Harris" "Jaylin Noel" "Jalen Royals"
## [13] "Savion Williams" "Tez Johnson" "Isaiah Bond"
## [16] "Tory Horton" "Pat Bryant" "Kobe Hudson"
## [19] "Kyle Williams" "Isaac TeSlaa" "Nick Nash"
## [22] "Jaylin Lane" "Tai Felton" "Antwane Wells Jr."
## [25] "Dont'e Thornton Jr." "KeAndre Lambert-Smith" "Kaden Prather"
## [28] "Chimere Dike" "Ricky White III" "Efton Chism III"
## [31] "Jimmy Horn Jr." "Samuel Brown Jr." "Will Sheppard"
## [34] "LaJohntay Wester" "Theo Wease Jr." "Kyren Lacy"
## [37] "Zakhari Franklin" "Roc Taylor" "Jackson Meeks"
## [40] "Bru McCoy" "Elijhah Badger" "Da'Quan Felton"
## [43] "Joey Hobert" "Julian Fleming" "Beaux Collins"
## [46] "Ja'Corey Brooks" "Moose Muhammad III" "Konata Mumpfield"
## [49] "Arian Smith"
receiver_summary <- pbp_2024 %>%
filter(completion == 1) %>%
group_by(receiver_player_name) %>%
summarize(total_plays = n(), total_epa = sum(EPA, na.rm = TRUE)) %>%
filter(!is.na(receiver_player_name), receiver_player_name %in% wr_players) %>%
rename(player = receiver_player_name)
datatable(receiver_summary)
combined_wr <- WR_Stats %>%
left_join(receiver_summary, by = "player")
datatable(combined_wr)
mean(combined_wr$rec_grade)
## [1] 75.25102
mean(combined_wr$yprr)
## [1] 2.281837
mean(combined_wr$drop)
## [1] 6.791837
mean(combined_wr$ctc)
## [1] 53.06327
mean(combined_wr$total_epa)
## [1] 65.21414
summary(combined_wr$total_epa)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.135 39.860 68.651 65.214 86.317 128.405
get_wr_values <- function(input_df) {
df_wr_copy <- input_df %>% mutate(
rec_grade = round(pmax(pmin((rec_grade-60) / 3, 10), 0), 2), # 60-90, mean 75
yprr = round(pmax(pmin((yprr-1.5) * 6.67, 10), 0), 2), # 1.5-3, mean 2.25
drop = round(pmax(pmin(((100-drop)-90) * 1.67, 10), 0), 2), # 10-4, mean 7
ctc = round(pmax(pmin((ctc-35) / 3, 10), 0), 2), # 35-65, mean 50
total_epa = round(pmax(pmin((total_epa-30) / 7, 10), 0), 2), # 30-100, mean 65
)
return(df_wr_copy)
}
new_stats_wr <- get_wr_values(combined_wr) %>%
mutate(total = rowSums(select(., -player, -adp, -total_plays, -rank, -pos_rank_bef, -team))) %>%
arrange(-total) %>%
mutate(pos = "WR", pos_rank_aft = row_number(), pos_rank_diff = pos_rank_bef-pos_rank_aft) %>%
select(player, rec_grade, yprr, drop, ctc, total_epa, total, rank, pos, team, pos_rank_bef, pos_rank_aft, pos_rank_diff)
datatable(new_stats_wr)
get the dataset that only contains the total and the ranks
wr_stats_total <- new_stats_wr %>%
select(player, total, rank, pos, team, pos_rank_bef, pos_rank_aft, pos_rank_diff)
datatable(wr_stats_total)
write.csv(wr_stats_total, "wr_stats_total.csv", row.names = FALSE)