From cfddf7f2762ffa25bd9278d3b9be2d06b51dd2fd Mon Sep 17 00:00:00 2001
From: "louis.heraut" <louis.heraut@inrae.fr>
Date: Mon, 10 Jan 2022 23:45:21 +0100
Subject: [PATCH] Cleaned and commented
---
plotting/map.R | 135 ++++++++++++++++++++++++++++++++-----------------
1 file changed, 88 insertions(+), 47 deletions(-)
diff --git a/plotting/map.R b/plotting/map.R
index c918ea0..5ef6db7 100644
--- a/plotting/map.R
+++ b/plotting/map.R
@@ -23,7 +23,7 @@
#
# plotting/map.R
#
-#
+# Deals with the creation of a map for presenting the trend analysis of hydrological variables
## 1. MAP PANEL
@@ -333,118 +333,145 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
df_data_code = df_data[df_data$code == code,]
# Extracts the trend corresponding to the code
df_trend_code = df_trend[df_trend$code == code,]
-
+
+ # Gets the associated time info
Start = Start_code[Code_code == code][[1]][idPer]
End = End_code[Code_code == code][[1]][idPer]
-
+
+ # Extracts the corresponding data for the period
df_data_code_per =
df_data_code[df_data_code$Date >= Start
& df_data_code$Date <= End,]
-
+ # Same for trend
df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start
& df_trend_code$period_end == End,]
-
+
+ # Computes the number of trend analysis selected
Ntrend = nrow(df_trend_code_per)
+ # If there is more than one trend on the same period
if (Ntrend > 1) {
+ # Takes only the first because they are similar
df_trend_code_per = df_trend_code_per[1,]
}
-
+
+ # Computes the mean of the data on the period
dataMean = mean(df_data_code_per$Qm3s, na.rm=TRUE)
+ # Normalises the trend value by the mean of the data
trendMean = df_trend_code_per$trend / dataMean
+ # Computes the color associated to the mean trend
color_res = get_color(trendMean,
minTrendMean[idPer, i],
maxTrendMean[idPer, i],
palette_name='perso',
reverse=TRUE,
ncolor=256)
-
+ # Computes the colorbar info
palette_res = get_palette(minTrendMean[idPer, i],
maxTrendMean[idPer, i],
palette_name='perso',
reverse=TRUE,
ncolor=256,
nbTick=nbTick)
-
+
+ # If it is significative
if (df_trend_code_per$p <= p_threshold){
+ # The computed color is stored
filltmp = color_res
-
+ # If the mean tend is positive
if (trendMean >= 0) {
+ # Uses a triangle up for the shape of the marker
shapetmp = 24
+ # If negative
} else {
+ # Uses a triangle down for the shape of the marker
shapetmp = 25
}
-
- } else {
+ # If it is not significative
+ } else {
+ # The fill color is grey
filltmp = 'grey97'
+ # The marker is a circle
shapetmp = 21
}
+ # Extracts the localisation of the current station
lontmp =
df_meta[df_meta$code == code,]$L93X_m_BH
lattmp =
df_meta[df_meta$code == code,]$L93Y_m_BH
+ # Stores all the parameters
lon = c(lon, lontmp)
lat = c(lat, lattmp)
fill = c(fill, filltmp)
shape = c(shape, shapetmp)
trend = c(trend, trendMean)
+ # If the trend analysis is significative a TRUE is stored
p_threshold_Ok = c(p_threshold_Ok,
df_trend_code_per$p <= p_threshold)
-
}
-
+ # Creates a tibble to stores all the data to plot
plot_map = tibble(lon=lon, lat=lat, fill=fill,
shape=shape, code=Code)
# If there is no specified station code to highlight (mini map)
if (is.null(codeLight)) {
map = map +
+ # Plots the trend point
geom_point(data=plot_map,
aes(x=lon, y=lat),
shape=shape, size=5, stroke=1,
color='grey50', fill=fill)
# If there is a specified station code
} else {
+ # Extract data of all stations not to highlight
plot_map_codeNo = plot_map[plot_map$code != codeLight,]
+ # Extract data of the station to highlight
plot_map_code = plot_map[plot_map$code == codeLight,]
-
+
+ # Plots only the localisation
map = map +
-
+ # For all stations not to highlight
geom_point(data=plot_map_codeNo,
aes(x=lon, y=lat),
shape=21, size=0.5, stroke=0.5,
color='grey70', fill='grey70') +
-
+ # For the station to highlight
geom_point(data=plot_map_code,
aes(x=lon, y=lat),
shape=21, size=1.5, stroke=0.5,
color='grey40', fill='grey40')
}
-
+
+ # Extracts the position of the tick of the colorbar
posTick = palette_res$posTick
+ # Extracts the label of the tick of the colorbar
labTick = palette_res$labTick
+ # Extracts the color corresponding to the tick of the colorbar
colTick = palette_res$colTick
-
- nbTickmod = length(posTick)
- valNorm = nbTickmod * 10
+ # Spreading of the colorbar
+ valNorm = nbTick * 10
+ # Normalisation of the position of ticks
ytick = posTick / max(posTick) * valNorm
-
+ # Formatting of label in pourcent
labTick = as.character(round(labTick*100, 2))
-
- xtick = rep(0, times=nbTickmod)
+ # X position of ticks all similar
+ xtick = rep(0, times=nbTick)
+
+ # Creates a tibble to store all parameters of colorbar
plot_palette = tibble(xtick=xtick, ytick=ytick,
colTick=colTick, labTick=labTick)
-
+
+ # New plot with void theme
title = ggplot() + theme_void() +
-
+ # Plots separation line
geom_line(aes(x=c(-0.3, 3.3), y=c(0.05, 0.05)),
size=0.6, color="#00A3A8") +
-
+ # Writes title
geom_shadowtext(data=tibble(x=-0.3, y=0.2,
label=type),
aes(x=x, y=y, label=label),
@@ -452,39 +479,40 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
color="#00A3A8",
bg.colour="white",
hjust=0, vjust=0, size=10) +
-
+ # X axis
scale_x_continuous(limits=c(-1, 1 + 3),
expand=c(0, 0)) +
-
+ # Y axis
scale_y_continuous(limits=c(0, 10),
expand=c(0, 0)) +
-
+ # Margin
theme(plot.margin=margin(t=5, r=5, b=0, l=0, unit="mm"))
-
+ # New plot with void theme
pal = ggplot() + theme_void() +
-
+ # Plots the point of the colorbar
geom_point(data=plot_palette,
aes(x=xtick, y=ytick),
shape=21, size=5, stroke=1,
color='white', fill=colTick)
pal = pal +
-
+ # Name of the colorbar
annotate('text',
x=-0.3, y= valNorm + 23,
label="Tendance",
hjust=0, vjust=0.5,
size=6, color='grey40') +
-
+ # Unit legend of the colorbar
annotate('text',
x=-0.2, y= valNorm + 13,
label=bquote(bold("% par an")),
hjust=0, vjust=0.5,
size=4, color='grey40')
-
- for (j in 1:nbTickmod) {
+ # For all the ticks
+ for (j in 1:nbTick) {
pal = pal +
+ # Adds the value
annotate('text', x=xtick[j]+0.3,
y=ytick[j],
label=bquote(bold(.(labTick[j]))),
@@ -493,11 +521,11 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
}
pal = pal +
-
+ # Up triangle in the marker legend
geom_point(aes(x=0, y=-20),
shape=24, size=4, stroke=1,
color='grey50', fill='grey97') +
-
+ # Up triangle text legend
annotate('text',
x=0.3, y=-20,
label=bquote(bold("Hausse significative à 10%")),
@@ -505,11 +533,11 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
size=3, color='grey40')
pal = pal +
-
+ # Circle in the marker legend
geom_point(aes(x=0, y=-29),
shape=21, size=4, stroke=1,
color='grey50', fill='grey97') +
-
+ # Circle text legend
annotate('text',
x=0.3, y=-29,
label=bquote(bold("Non significatif à 10%")),
@@ -517,45 +545,58 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer=1, outdirTmp=''
size=3, color='grey40')
pal = pal +
-
+ # Down triangle in the marker legend
geom_point(aes(x=0, y=-40),
shape=25, size=4, stroke=1,
color='grey50', fill='grey97') +
-
+ # Down triangle text legend
annotate('text',
x=0.3, y=-40,
label=bquote(bold("Baisse significative à 10%")),
hjust=0, vjust=0.5,
size=3, color='grey40')
-
+
+ # Normalises all the trend values for each station
+ # according to the colorbar
yTrend = (trend - minTrendMean[idPer, i]) /
(maxTrendMean[idPer, i] - minTrendMean[idPer, i]) * valNorm
-
+ # Takes only the significative ones
yTrend = yTrend[p_threshold_Ok]
## Random distribution ##
# xTrend = rnorm(length(yTrend), mean=1.75, sd=0.1)
- ## Histogram distribution ##
+ ## Histogram distribution ##
+ # Computes the histogram of the trend
res_hist = hist(yTrend, breaks=ytick, plot=FALSE)
+ # Extracts the number of counts per cells
counts = res_hist$counts
+ # Extracts limits of cells
breaks = res_hist$breaks
+ # Extracts middle of cells
mids = res_hist$mids
+ # Blank vectors to store position of points of
+ # the distribution to plot
xTrend = c()
yTrend = c()
+ # Start X position of the distribution
start_hist = 1.25
+ # X separation bewteen point
hist_sep = 0.15
-
+ # For all cells of the histogram
for (ii in 1:length(mids)) {
-
+ # If the count in the current cell is not zero
if (counts[ii] != 0) {
+ # Stores the X positions of points of the distribution
+ # for the current cell
xTrend = c(xTrend,
seq(start_hist,
start_hist+(counts[ii]-1)*hist_sep,
by=hist_sep))
}
-
+ # Stores the Y position which is the middle of the
+ # current cell the number of times it has been counted
yTrend = c(yTrend, rep(mids[ii], times=counts[ii]))
}
--
GitLab