install.packages(c(“tidyverse”, “tsibble”, “fabletools”, “fable”, “lubridate”, “janitor”, “feasts”)) library(tidyverse) library(tsibble) library(fabletools) library(fable) library(lubridate) library(janitor) library(feasts) library(dplyr) ufc_master <- read_csv(“ufc-master.csv”) fightmetric <- read_csv(“fightmetric.csv”) %>% mutate(Fighter = str_c(First Name, ” “, Last Name))
ufc_long <- ufc_master %>% pivot_longer(cols = c(RedFighter, BlueFighter), names_to = “Side”, values_to = “Fighter”)
ufc_long <- ufc_long %>% mutate(TitleBout = replace_na(TitleBout, FALSE), TitleBoutFlag = if_else(TitleBout == TRUE, TRUE, FALSE))
fighter_info <- ufc_long %>% group_by(Fighter) %>% summarize(Recent_Fight_Date = max(Date, na.rm = TRUE), Ever_Title = any(TitleBoutFlag), .groups = “drop”)
combined_data <- left_join(fightmetric, fighter_info, by = “Fighter”) write_csv(combined_data, “combined_fight_info_yay.csv”)
combined_data <- read_csv(“combined_fight_info_yay.csv”) combined_data <- combined_data %>% mutate(Weight_Class = case_when( Weight >= 105 & Weight <= 113 ~ “atomweight”, Weight >= 113 & Weight <= 123 ~ “straweight”, Weight >= 123 & Weight <= 133 ~ “flyweight”, Weight >= 134 & Weight <= 143 ~ “bantamweight”, Weight >= 144 & Weight <= 153 ~ “featherweight”, Weight >= 154 & Weight <= 163 ~ “lightweight”, Weight >= 164 & Weight <= 183 ~ “welterweight”, Weight >= 184 & Weight <= 200 ~ “middleweight”, Weight >= 201 & Weight <= 225 ~ “light heavyweight”, Weight > 225 ~ “heavyweight”, TRUE ~ NA_character_ )) write_csv(combined_data, “FinalUFCData.csv”)
final_data <- read_csv(“FinalUFCData.csv”) final_data <- final_data %>% mutate(Nickname = replace_na(Nickname, “None”)) final_data_clean <- final_data %>% filter(if_all(-all_of(c(“Nickname”, “Ever_Title”)), ~ !is.na(.))) write_csv(final_data_clean, “FinalUFCDataFinal.csv”)
ufc_data <- read_csv(“FinalUFCDataFinal.csv”) %>% clean_names() glimpse(raw_data) summary(raw_data) colnames(ufc_data)
dup_check <- ufc_data %>% select(fighter, date) %>% duplicated()
if(any(dup_check)) { message(“Duplicate rows found based on fighter and date. Removing duplicates…”) ufc_data <- ufc_data %>% distinct(weight_class, recent_fight_date, .keep_all = TRUE) } else { message(“No duplicates found based on fighter and date.”) }
ufc_agg <- ufc_data %>% group_by(weight_class, date)
%>%
summarise(mean_slpm = mean(s_lp_m, na.rm = TRUE)) %>% ungroup()
ufc_tsibble <- ufc_agg %>% as_tsibble(key = weight_class, index = date)
ufc_tsibble %>% autoplot(mean_slpm) + labs(title = “Average SLpM over Time by Weightclass”, x = “Date”, y = “s_lp_m”)
ufc_tsibble %>% filter(weight_class %in% c(“lightweight”, “welterweight”, “middleweight”)) %>% autoplot(mean_slpm) + labs(title = “Average SLpM for Selected Weightclasses”, x = “Date”, y = “Mean s_lp_m”)
trend_estimates <- ufc_agg %>% group_by(weight_class) %>% arrange(date) %>% mutate(time_numeric = as.numeric(date), trend_loess = loess(mean_slpm ~ time_numeric, span = 0.3)$fitted) %>% ungroup()
print(trend_estimates)
trend_plotl <- trend_estimates %>% filter(weight_class == “lightweight”) %>% ggplot(aes(x = date)) + geom_point(aes(y = ‘s_lp_m’), color = “black”, alpha = 0.6) + geom_line(aes(y = trend_loess), color = “red”, linewidth = 1.2) + labs(title = “Trend Report for Lightweight”, subtitle = “Black points = observed mean SLpM; Red line = loess trend”, x = “Date”, y = “Mean SLpM”) trend_plotl
trend_plotw <- trend_estimates %>% filter(weight_class == “welterweight”) %>% ggplot(aes(x = date)) + geom_point(aes(y = ‘s_lp_m’), color = “black”, alpha = 0.6) + geom_line(aes(y = trend_loess), color = “red”, linewidth = 1.2) + labs(title = “Trend Report for welterweight”, subtitle = “Black points = observed mean SLpM; Red line = loess trend”, x = “Date”, y = “Mean SLpM”) trend_plotw
trend_plotm <- trend_estimates %>% filter(weight_class == “middleweight”) %>% ggplot(aes(x = date)) + geom_point(aes(y = ‘s_lp_m’), color = “black”, alpha = 0.6) + geom_line(aes(y = trend_loess), color = “red”, linewidth = 1.2) + labs(title = “Trend Report for middleweight”, subtitle = “Black points = observed mean SLpM; Red line = loess trend”, x = “Date”, y = “Mean SLpM”) trend_plotm
seasonality_report <- trend_estimates %>% mutate(month = month(date, label = TRUE)) %>% group_by(weightclass, month) %>% summarise(season_effect = mean(mean_slpm - trend_loess, na.rm = TRUE)) %>% ungroup() print(seasonality_report)
seasonality_plotl <- seasonality_report %>% filter(weight_class == “lightweight”) %>% ggplot(aes(x = month, y = season_effect)) + geom_col(fill = “skyblue”) + labs(title = “Seasonality Report for Lightweight”, subtitle = “Average deviation from trend by month”, x = “Month”, y = “Seasonal Effect (Deviation)”) seasonality_plotl
seasonality_plotw <- seasonality_report %>% filter(weight_class == “welterweight”) %>% ggplot(aes(x = month, y = season_effect)) + geom_col(fill = “red”) + labs(title = “Seasonality Report for Lightweight”, subtitle = “Average deviation from trend by month”, x = “Month”, y = “Seasonal Effect (Deviation)”) seasonality_plotw
seasonality_plotm <- seasonality_report %>% filter(weight_class == “middleweight”) %>% ggplot(aes(x = month, y = season_effect)) + geom_col(fill = “red”) + labs(title = “Seasonality Report for Lightweight”, subtitle = “Average deviation from trend by month”, x = “Month”, y = “Seasonal Effect (Deviation)”) seasonality_plotm
desired_weight_classes <- c(“featherweight”, “lightweight”, “welterweight”, “middleweight”) ufc_filtered <- ufc_data %>% filter(weight_class %in% desired_weight_classes)
agg_data <- ufc_filtered %>% group_by(weight_class, date) %>% summarise( mean_slpm = mean(s_lp_m, na.rm = TRUE), mean_sapm = mean(s_ap_m, na.rm = TRUE), mean_stracc = mean(str_acc, na.rm = TRUE), mean_tdacc = mean(td_acc, na.rm = TRUE), mean_tdav = mean(td_avg, na.rm = TRUE), mean_tddef = mean(td_def, na.rm = TRUE) ) %>% ungroup()
trend_estimates <- agg_data %>% group_by(weight_class) %>% arrange(date) %>% mutate( time_numeric = as.numeric(date), trend_loess_slpm = loess(mean_slpm ~ time_numeric, span = 0.3)\(fitted, trend_loess_sapm = loess(mean_sapm ~ time_numeric, span = 0.3)\)fitted, trend_loess_stracc = loess(mean_stracc ~ time_numeric, span = 0.3)\(fitted, trend_loess_tdacc = loess(mean_tdacc ~ time_numeric, span = 0.3)\)fitted, trend_loess_tdav = loess(mean_tdav ~ time_numeric, span = 0.3)\(fitted, trend_loess_tddef = loess(mean_tddef ~ time_numeric, span = 0.3)\)fitted ) %>% ungroup()
trend_with_dev <- trend_estimates %>% mutate( dev_slpm = mean_slpm - trend_loess_slpm, dev_sapm = mean_sapm - trend_loess_sapm, dev_stracc = mean_stracc - trend_loess_stracc, dev_tdacc = mean_tdacc - trend_loess_tdacc, dev_tdav = mean_tdav - trend_loess_tdav, dev_tddef = mean_tddef - trend_loess_tddef, month = month(date, label = TRUE) )
seasonality_data <- trend_with_dev %>% select(date, weight_class, month, starts_with(“dev_”)) %>% pivot_longer( cols = starts_with(“dev_”), names_to = “stat_name”, values_to = “deviation” ) %>% mutate(stat_name = str_remove(stat_name, “dev_”)) %>% group_by(weight_class, stat_name, month) %>% summarise(avg_deviation = mean(deviation, na.rm = TRUE), .groups = “drop”)
glimpse(seasonality_data) print(seasonality_data)
seasonality_plot <- ggplot(seasonality_data, aes(x = month, y = avg_deviation, fill = weight_class)) + geom_col(position = “dodge”) + facet_wrap(~ stat_name, scales = “free_y”) + labs( title = “Seasonality Report for Selected Weight Classes”, subtitle = “Average Monthly Deviation from Trend (Observed - Trend)”, x = “Month”, y = “Average Deviation”, fill = “Weight Class” ) + theme_minimal()
print(seasonality_plot) #Model
long_ts <- agg_data %>% pivot_longer( cols = starts_with(“mean_”), names_to = “stat_name”, values_to = “value” ) %>% mutate(stat_name = str_remove(stat_name, “mean_”)) %>% as_tsibble(key = c(weight_class, stat_name), index = date)
agg_data %>% summarise( first_date = 2015-01-01, last_date = 2024-12-01 ) split_date <- as.Date(“2024-01-01”)
valid_series <- train_ts %>% group_by(weight_class, stat_name) %>% summarise(n_obs = sum(!is.na(value)), .groups=“drop”) %>% filter(n_obs >= 2) %>% select(weight_class, stat_name)
train_for_models <- train_ts %>% inner_join(valid_series, by = c(“weight_class”, “stat_name”)) %>% fill_gaps()
models <- train_for_models %>% model( tslm = TSLM(value ~ trend() + season()), ets = ETS(value), arima = ARIMA(value) )
models %>% glance() %>% arrange(AICc) %>% print()
models %>% filter(weight_class==“lightweight”, stat_name==“slpm”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“sapm”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“stracc”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“tddef”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“tdav”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“tdacc”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“slpm”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“sapm”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“stracc”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“tddef”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“tdav”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“tdacc”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“slpm”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“sapm”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“stracc”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“tddef”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“tdav”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“tdacc”) %>% select(arima) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“slpm”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“sapm”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“stracc”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“tddef”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“tdav”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“lightweight”, stat_name==“tdacc”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“slpm”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“sapm”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“stracc”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“tddef”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“tdav”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“featherweight”, stat_name==“tdacc”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“slpm”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“sapm”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“stracc”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“tddef”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“tdav”) %>% select(tslm) %>% gg_tsresiduals()
models %>% filter(weight_class==“welterweight”, stat_name==“tdacc”) %>% select(tslm) %>% gg_tsresiduals()
#Benchmarks pred_ts_unique <- pred_ts %>% distinct(weight_class, date, .keep_all = TRUE)
train_for_models <- train_ts %>% inner_join(valid_series, by = c(“weight_class”,“stat_name”)) %>% fill_gaps() %>% left_join(pred_ts_unique, by = c(“weight_class”,“date”)) valid_series <- valid_series %>% distinct(weight_class, stat_name)
train_for_models <- train_ts %>% inner_join(valid_series, by = c(“weight_class”,“stat_name”)) %>% fill_gaps()
train_for_models <- train_ts %>% inner_join( valid_series, by = c(“weight_class”,“stat_name”), relationship = “many-to-many” ) %>% fill_gaps() %>% left_join( pred_ts, by = c(“weight_class”,“date”), relationship = “many-to-many” ) pred_ts_unique <- pred_ts %>% distinct(weight_class, date, .keep_all = TRUE)
train_for_models <- train_ts %>% inner_join(valid_series, by = c(“weight_class”,“stat_name”)) %>% fill_gaps() %>% left_join(pred_ts_unique, by = c(“weight_class”,“date”)) library(fable)
benchmarks <- train_for_models %>% model( naive =
NAIVE(value),
snaive = SNAIVE(value),
drift = RW(value ~ drift())
) print(benchmarks)
library(dplyr) library(tidyr)
library(dplyr) library(fable) library(tidyr)
h <- nrow(test_ts) fc_models <- models %>% select(ets, arima) %>% forecast(h = h) fc_bench <- benchmarks %>% forecast(h = h)
acc_models <- accuracy(fc_models, test_ts) %>% mutate(type = “fitted”) acc_bench <- accuracy(fc_bench, test_ts) %>% mutate(type = “benchmark”)
acc_all <- bind_rows(acc_models, acc_bench)
acc_long <- acc_all %>% pivot_longer( cols = c(ME, RMSE, MAE, MPE, MAPE, MASE, ACF1), names_to = “.measure”, values_to= “.value” )
print(acc_long)
acc_long %>% filter(.measure == “RMSE”) %>% arrange(type, .model, weight_class, stat_name, .value) %>% print(n = Inf)
library(dplyr) library(tidyr)
acc_long <- acc_all %>% pivot_longer( cols = c(ME, RMSE, MAE, MPE, MAPE, MASE, ACF1), names_to = “.measure”, values_to = “.value” )
acc_long %>% arrange(type, .model, .measure, .value) %>% print(n = Inf)
acc_long %>% filter(.measure == “RMSE”) %>% arrange(type, .model, .value) %>% print(n = Inf)
best_by_rmse <- acc_long %>% filter(.measure == “RMSE”) %>% group_by(weight_class, stat_name) %>% slice_min(.value, n = 1, with_ties = FALSE) %>% ungroup()
print(best_by_rmse)
best_summary <- best_by_rmse %>% count(type, .model) %>% arrange(desc(n))
print(best_summary)
library(fable)
final_models <- long_ts %>% fill_gaps() %>%
group_by(weight_class, stat_name) %>% arrange(date) %>%
mutate(value = na.interp(value)) %>%
ungroup() %>% model( final_arima = ARIMA(value) )
h <- 12 future_fc <- final_models %>% forecast(h = h)
library(ggplot2)
future_fc %>% autoplot(long_ts, level = c(80, 95)) + facet_grid(stat_name ~ weight_class, scales = “free_y”) + labs( title = “12‑Month Ahead Forecasts (Final ARIMA Models)”, x = “Date”, y = “Value” ) + theme_minimal()
library(ggplot2) library(lubridate)
start_fc <- min(future_fc\(date) end_fc <- max(future_fc\)date)
future_fc %>% autoplot(long_ts, level = c(80, 95)) + facet_grid(stat_name ~ weight_class, scales = “free_y”) + scale_x_date( limits = c(start_fc, end_fc), date_labels = “%b %Y”, date_breaks = “1 month” ) + labs( title = “12‑Month Ahead Forecasts (Final ARIMA Models)”, x = “Date”, y = “Value” ) + theme_minimal() + theme( axis.text.x = element_text(angle = 45, hjust = 1) )