add : first trying work on relative deviation

refs #13

dev/Ecart_relatifs_YS.R

+library(dplyr)
+library(stringr)
+library(ggplot2)
+
+data(historical)
+
+# Your provided pattern of base IDs
+baseIds <- c("2006_06671AL", "2006_06671BL", "2009_09670AL", "2010_10526AL",
+             "2011_11526AL", "2012_12526AL", "2012_12526BL", "2013_13526AL",
+             "2013_13526BL", "2014_14526AL", "2014_14526BL", "2014_14526BL",
+             "2015_15671AL", "2015_15671BL", "2016_16526AL", "2016_16526BL",
+             "2017_17526AL", "2017_17526BL", "2018_18526AL", "2018_18526BL",
+             "2019_19526AL", "2019_19526BL", "2021_21526AL", "2021_21526BL",
+             "2022_22526AL", "2022_22526BL", "2023_23526AL", "2023_23526BL")
+
+# Étape 1: Extraire la partie "baseId" et le suffixe (e.g., "ArrP", "ArrT", etc.) de chaque nom
+outputsNames <- names(outputsProjects)
+outputsProjects_base <- str_extract(outputsNames, "^[0-9]{4}_[0-9]{5}[A-Z]{2}")
+suffixes <- str_extract(outputsNames, "(?<=_)[A-Za-z]+$")
+
+# Étape 2: Créer un data.frame pour associer les noms de base et leurs suffixes
+df <- data.frame(baseId = outputsProjects_base, suffix = suffixes, outputName = outputsNames, stringsAsFactors = FALSE)
+
+# Étape 3: Initialiser une nouvelle liste pour stocker les résultats agrégés avec contenu aplati
+aggregatedProjects <- list()
+
+# Étape 4: Boucler sur chaque baseId pour agréger les suffixes et leurs contenus sans fusionner les noms
+for(baseId in baseIds) {
+  # Trouver les noms correspondants à chaque baseId
+  matchedData <- df %>%
+    filter(baseId == !!baseId) %>%
+    select(suffix, outputName)
+
+  # Créer une sous-liste pour ce baseId
+  subList <- list()
+
+  # Remplir la sous-liste avec les suffixes et leur contenu sans changer les noms
+  for(i in 1:nrow(matchedData)) {
+    suffix <- matchedData$suffix[i]
+    outputName <- matchedData$outputName[i]
+    # Ajouter les éléments de la sous-liste directement sans modifier les noms
+    subList[[suffix]] <- outputsProjects[[outputName]][[1]]  # Accède directement au premier élément pour enlever le niveau de liste
+  }
+
+  # Stocker cette sous-liste dans la liste agrégée
+  aggregatedProjects[[baseId]] <- subList
+}
+# Fonction pour calculer l'écart relatif entre deux valeurs maximales de YS
+relative_diff_max <- function(ys1, ys2) {
+  epsilon <- 1e-9  # Pour éviter la division par zéro
+  max_ys1 <- max(ys1, na.rm = TRUE) + epsilon
+  max_ys2 <- max(ys2, na.rm = TRUE) + epsilon
+  return((max_ys1 - max_ys2) / max_ys2)  # Calcul de l'écart relatif des max
+}
+
+# Boucle sur chaque élément de la liste aggregatedProjects pour calculer et stocker les écarts relatifs des valeurs maximales
+for (element_name in names(aggregatedProjects)) {
+  element <- aggregatedProjects[[element_name]]
+
+  # Extraire les noms des sous-éléments (scénarios)
+  sub_elements <- names(element)
+
+  # Vérifier s'il y a au moins deux sous-éléments pour faire des combinaisons
+  if (length(sub_elements) < 2) {
+    cat("Skipping element:", element_name, "- not enough sub-elements\n")
+    next  # Si moins de 2 sous-éléments, passer à l'élément suivant
+  }
+
+  # Générer toutes les combinaisons de 2 sous-éléments
+  combinations <- combn(sub_elements, 2, simplify = FALSE)  # Générer les paires de combinaisons
+
+  # Initialiser une liste pour stocker les écarts relatifs des max pour ce baseId
+  comparison_results <- list()
+
+  # Calculer l'écart relatif pour chaque paire de sous-éléments sur les valeurs maximales
+  for (combo in combinations) {
+    sub1 <- combo[1]
+    sub2 <- combo[2]
+
+    ys1 <- element[[sub1]]$YS  # Récupérer le vecteur YS du premier sous-élément
+    ys2 <- element[[sub2]]$YS  # Récupérer le vecteur YS du second sous-élément
+
+    # Vérification pour s'assurer que les vecteurs "YS" existent
+    if (is.null(ys1) || is.null(ys2)) {
+      cat("Missing 'YS' in one of the sub-elements:", sub1, sub2, "in", element_name, "\n")
+      next  # Sauter cette combinaison si "YS" est manquant
+    }
+
+    # Calculer l'écart relatif entre les valeurs maximales des deux vecteurs "YS"
+    relative_difference_max <- relative_diff_max(ys1, ys2)
+
+    # Stocker le résultat dans un nom clair du type "scenario1/scenario2"
+    comparison_name <- paste(sub1, sub2, sep = "/")
+    comparison_results[[comparison_name]] <- relative_difference_max
+  }
+
+  # Ajouter les résultats des comparaisons des valeurs maximales dans la sous-liste du baseId actuel
+  aggregatedProjects[[element_name]]$max_comparisons <- comparison_results
+  cat("Added max comparisons for", element_name, "\n")
+}
+
+# Extraire les résultats des max_comparisons pour créer un data.frame pour le barplot
+results_max_df <- data.frame(baseId = character(), comparison = character(), relative_difference_max = numeric())
+
+for (baseId in names(aggregatedProjects)) {
+  comparisons <- aggregatedProjects[[baseId]]$max_comparisons
+
+  if (!is.null(comparisons)) {
+    for (comparison_name in names(comparisons)) {
+      temp_df <- data.frame(
+        baseId = baseId,
+        comparison = comparison_name,
+        relative_difference_max = comparisons[[comparison_name]]
+      )
+      results_max_df <- rbind(results_max_df, temp_df)
+    }
+  }
+}
+
+# Créer le barplot des écarts relatifs maximaux avec des axes X et Y indépendants
+ggplot(results_max_df, aes(x = comparison, y = relative_difference_max, fill = comparison)) +
+  geom_bar(stat = "identity", position = "dodge") +
+  facet_wrap(~ baseId, scales = "free") +  # Ajustement dynamique de l'axe X et Y par baseId
+  labs(title = "Écarts relatifs des rendements maximaux par baseId",
+       x = "Comparaison de scénarios",
+       y = "Écart relatif des rendements maximaux (%)") +
+  theme_minimal() +
+  theme(axis.text.x = element_text(angle = 45, hjust = 1),
+        strip.text = element_text(size = 8))  # Ajuste la taille du texte des facettes si nécessaire
+
+# Créer une fonction pour donner un score théorique aux comparaisons
+get_theoretical_order <- function(comparison) {
+  # Définir l'ordre théorique des comparaisons en fonction de l'impact
+  order <- c(
+    "Irri/Tem", "ArrT/Tem", "ArrP/Tem", "IrriMn/Tem", "Irri/IrriMn",
+    "ArrP/ArrT", "Dclt/Tem", "Dclt/Irri"
+    # Ajoute ici d'autres combinaisons selon ton modèle théorique
+  )
+
+  # Retourner l'indice dans cet ordre (plus l'indice est petit, plus l'écart est théorique élevé)
+  return(match(comparison, order, nomatch = length(order) + 1))  # Si la combinaison n'existe pas, donner une valeur haute
+}
+
+# Appliquer cette fonction à chaque comparaison pour créer une colonne avec cet ordre théorique
+results_max_df$theoretical_order <- sapply(results_max_df$comparison, get_theoretical_order)
+
+# Créer le barplot des écarts relatifs maximaux avec des axes X et Y indépendants, et ordre inversé
+num_comparisons <- length(unique(results_max_df$comparison))
+sexy_colors <- scales::hue_pal()(num_comparisons)  # Génère un nombre de couleurs égal au nombre de comparaisons
+
+# Créer le barplot des écarts relatifs maximaux avec des axes X et Y indépendants, et rendu "sexy"
+ggplot(results_max_df, aes(x = reorder(comparison, -theoretical_order), y = relative_difference_max, fill = comparison)) +
+  geom_bar(stat = "identity", position = "dodge", color = "black", linewidth = 0.3, width = 0.8) +  # Utilisation de linewidth au lieu de size
+  facet_wrap(~ baseId, scales = "free") +  # Ajustement dynamique de l'axe X et Y par baseId
+  labs(title = "Comparaison des écarts relatifs des rendements maximaux",
+       subtitle = "Par scénario d'irrigation et par essai (BaseID)",  # Sous-titre pour plus d'infos
+       x = "Comparaison de scénarios",
+       y = "Écart relatif des rendements maximaux (%)") +
+  scale_fill_manual(values = sexy_colors) +  # Palette de couleurs générée automatiquement
+  theme_minimal(base_size = 14) +  # Thème minimal avec une taille de police ajustée
+  theme(
+    plot.title = element_text(face = "bold", hjust = 0.5, size = 18),  # Titre centré et en gras
+    plot.subtitle = element_text(hjust = 0.5, size = 12),  # Sous-titre centré
+    axis.title.x = element_text(face = "bold"),  # Axe X en gras
+    axis.title.y = element_text(face = "bold"),  # Axe Y en gras
+    axis.text.x = element_text(angle = 45, hjust = 1, size = 10, face = "italic"),  # Labels X inclinés et en italique
+    axis.text.y = element_text(size = 12),  # Taille du texte de l'axe Y augmentée
+    legend.position = "none",  # Cacher la légende pour un effet épuré
+    strip.text = element_text(face = "bold", size = 12),  # Taille et style du texte des facettes
+    panel.grid.major = element_line(color = "grey80"),  # Grille légère pour un effet subtil
+    panel.grid.minor = element_blank()  # Pas de lignes de grille mineures
+)
+
+