Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
optirrigBEET
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
OptirrigHIVE
optirrigBEET
Commits
7a4e2921
Commit
7a4e2921
authored
4 months ago
by
RICQUIER FLORIAN
Browse files
Options
Downloads
Patches
Plain Diff
add : first trying work on relative deviation
refs
#13
parent
daa3f8d5
No related branches found
Branches containing commit
No related tags found
Tags containing commit
1 merge request
!1
up : add missing imports
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
dev/Ecart_relatifs_YS.R
+174
-0
174 additions, 0 deletions
dev/Ecart_relatifs_YS.R
with
174 additions
and
0 deletions
dev/Ecart_relatifs_YS.R
0 → 100644
+
174
−
0
View file @
7a4e2921
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
)
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment