[HEAD]: initial commit

2026-08-04 19:19:24 +01:00
commit 2d9bfafbe6
39 changed files with 8905 additions and 0 deletions
@@ -0,0 +1,126 @@
+##correlation coefficient----
+cor_matrix <- season_league_full_dataset %>%
+  select(-c(Country, Season, season_start)) %>%
+  cor(use = "pairwise.complete.obs")
+
+plot_ly(
+  x = colnames(cor_matrix),
+  y = rownames(cor_matrix),
+  z = cor_matrix,
+  type = "heatmap",
+  colorscale = "RdBu",
+  zmin = -1,
+  zmax = 1,
+  showscale = TRUE
+) %>%
+  add_trace(
+    x = rep(colnames(cor_matrix), each = nrow(cor_matrix)),
+    y = rep(rownames(cor_matrix), times = ncol(cor_matrix)),
+    text = sprintf("%.2f", as.vector(cor_matrix)),
+    type = "scatter",
+    mode = "text"      ,
+    textfont = list(color = "black"),
+    hoverinfo = "none",
+    showlegend = FALSE
+  ) %>%
+  layout(
+    xaxis = list(tickangle = 45),
+    yaxis = list(autorange = "reversed")
+  )
+
+#drop multicollinearity variables
+season_league_full_dataset_no_multicollinearity <- season_league_full_dataset %>%
+  select(-c(Winners_GD, First_and_relegated))
+
+
+##competitiveness index----
+scaled_full_data_competitiveness_index <- scaled_full_data %>%
+  mutate(competitive_title_index =
+           rowMeans(cbind(-First_and_second, -First_and_CL)),
+         elite_dominance_index =
+           rowMeans(cbind(CL_and_relegated, Top_4_total_GD, Gini_coefficient,
+                          Average_goals_by_top_3_players)),
+         competitive_balance_index =
+           rowMeans(cbind(-First_and_second, -First_and_CL, -CL_and_relegated,
+                          -Top_4_total_GD, -Gini_coefficient)),
+         player_rotation_index = Average_number_of_players,
+         multilevel_competitiveness_index =
+           rowMeans(cbind(-First_and_second, -First_and_CL, -CL_and_relegated))
+  )
+#by competition breakdown
+scaled_full_data_comp_breakdown_competitiveness_index <- scaled_full_data_comp_breakdown %>%
+  mutate(competitive_title_index =
+           rowMeans(cbind(-First_and_second, -First_and_CL)),
+         elite_dominance_index =
+           rowMeans(cbind(CL_and_relegated, Top_4_total_GD, Gini_coefficient,
+                          Average_goals_by_top_3_players)),
+         competitive_balance_index =
+           rowMeans(cbind(-First_and_second, -First_and_CL, -CL_and_relegated,
+                          -Top_4_total_GD, -Gini_coefficient)),
+         player_rotation_index = Average_number_of_players,
+         multilevel_competitiveness_index =
+           rowMeans(cbind(-First_and_second, -First_and_CL, -CL_and_relegated))
+  )
+#for clustering
+pivoted_scaled_full_data_comp_breakdown_competitiveness_index <- scaled_full_data_comp_breakdown_competitiveness_index %>%
+  pivot_wider(names_from = competition, values_from = c(European_performance, lead_european_performance)) %>%
+  mutate(European_performance = 2*European_performance_CL + European_performance_EL,
+         lead_european_performance = 2*lead_european_performance_CL + lead_european_performance_EL)
+
+##principal component analysis----
+pca_data <- season_league_full_dataset %>%
+  select(-c(Season, Country, season_start, European_performance, lead_european_performance))
+pca <- prcomp(pca_data, center = TRUE, scale. = TRUE)
+#weights of each variable in the principal components
+loadings <- as.data.frame(pca$rotation) %>%
+  rownames_to_column("Variable")
+#calculating proportion of variance explained by each component
+pca.var <- pca$sdev^2
+propve <- pca.var / sum(pca.var)
+plot(cumsum(propve), xlab = "Principal Component",
+     ylab = "Cumulative Proportion of Variance Explained",
+     ylim = c(0, 1), type = "b")
+abline(h=0.9, lty = "dashed")
+which(cumsum(propve) >= 0.9)[1] #number of principal components that explain at least 90% of variance
+#values of the observations on each principal component
+pc_scores <- as.data.frame(pca$x[, 1:5])
+pc_scores["PC1"] <- pc_scores["PC1"] * -1
+pca_results <- bind_cols(
+  scaled_full_data,
+  pc_scores
+)
+#by competition breakdown
+comp_breakdown_pc_scores <- pc_scores %>%
+  slice(rep(1:n(), each = 2))
+pca_results_comp_breakdown <- bind_cols(
+  scaled_full_data_comp_breakdown,
+  comp_breakdown_pc_scores
+)
+#reformatting data for plotting composition of components
+loadings_plotting <- loadings %>%
+  select(Variable, PC1:PC5) %>%
+  pivot_longer(
+    cols = starts_with("PC"),
+    names_to = "PC",
+    values_to = "Loading"
+  ) %>%
+  mutate(Loading = ifelse(PC == "PC1", Loading*-1, Loading))
+#plotting
+ggplot(loadings_plotting %>% filter(PC == "PC4"),
+       aes(x = reorder(Variable, abs(Loading)),
+           y = Loading,
+           fill = Loading > 0)) +
+  geom_col() +
+  coord_flip() +
+  scale_fill_manual(values = c("TRUE" = "steelblue",
+                               "FALSE" = "firebrick")) +
+  labs(
+    x = NULL,
+    y = "Loading",
+    title = "PCA Loadings for Principal Components explaining 90% of variance"
+  ) +
+  theme_minimal() +
+  theme(
+    legend.position = "none",
+    strip.text = element_text(face = "bold")
+  )