An error occurred while loading the file. Please try again.
-
Heraut Louis authored4e58b039
# \\\# Copyright 2021-2022 Louis Héraut*1## *1 INRAE, France# louis.heraut@inrae.fr## This file is part of ash R toolbox.## ash R toolbox is free software: you can redistribute it and/or modify# it under the terms of the GNU General Public License as published by# the Free Software Foundation, either version 3 of the License, or (at# your option) any later version.## ash R toolbox is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU# General Public License for more details.## You should have received a copy of the GNU General Public License# along with ash R toolbox. If not, see <https://www.gnu.org/licenses/>.# ///### plotting/matrix.R## Allows the creation of a summarizing matrix of trend and break analyses## 1. MATRIX PANEL ___________________________________________________# Generates a summarizing matrix of the trend analyses of all station for different hydrological variables and periods. Also shows difference of means between specific periods.matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period, colorForce=FALSE, slice=NULL, outdirTmp='', outnameTmp='matrix', title=NULL, A3=FALSE, foot_note=FALSE, foot_height=0, resources_path=NULL, logo_dir=NULL, AEAGlogo_file=NULL, INRAElogo_file=NULL, FRlogo_file=NULL, df_page=NULL) { # Number of variable/plot nbp = length(list_df2plot) # Get all different stations code Code = levels(factor(df_meta$code)) nCode = length(Code) # Convert 'trend_period' to list trend_period = as.list(trend_period) # Number of trend period nPeriod_trend = length(trend_period) # Extracts the min and the max of the mean trend for all the station res = short_trendExtremes(list_df2plot, Code, nPeriod_trend, nbp, nCode, colorForce) minTrendValue = res$min maxTrendValue = res$max # Blank vectors to store info about trend analyses Periods_trend = c() NPeriod_trend = c() Var_trend = c() Type_trend = c() Code_trend = c() Alpha_trend = c() TrendValue_trend = c() DataMean_trend = c() Fill_trend = c() Color_trend = c() # For all the trend period for (j in 1:nPeriod_trend) { # For all code7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
for (k in 1:nCode) {
# Gets the code
code = Code[k]
# For all variable
for (i in 1:nbp) {
# Extracts the data corresponding to the current variable
df_data = list_df2plot[[i]]$data
# Extracts the trend corresponding to the
# current variable
df_trend = list_df2plot[[i]]$trend
alpha = list_df2plot[[i]]$alpha
# Extract the variable of the plot
var = list_df2plot[[i]]$var
# Extract the type of the variable to plot
type = list_df2plot[[i]]$type
# Extracts the data corresponding to the code
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,]
# Extract start and end of trend periods
Start = df_trend_code$period_start[j]
End = df_trend_code$period_end[j]
# Creates a period name
Periods = paste(Start, End,
sep=' / ')
# 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$Value, na.rm=TRUE)
# If it is a flow variable
if (type == 'sévérité') {
# Normalises the trend value by the mean of the data
trendValue = df_trend_code_per$trend / dataMean
# If it is a date variable
} else if (type == 'saisonnalité') {
# Just stocks the trend value
trendValue = df_trend_code_per$trend
}
# Gets the color associated to the averaged trend
color_res = get_color(trendValue,
minTrendValue[j, i],
maxTrendValue[j, i],
palette_name='perso',
reverse=TRUE)
pVal = df_trend_code_per$p
# If the p value is under the threshold
if (pVal <= alpha){
# Specifies the color fill and contour of
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
# table cells
fill = color_res
color = color_res
Alpha = 'TRUE'
} else if (pVal > alpha & colorForce) {
# Specifies the color fill and contour of
# table cells
fill = 'white'
color = color_res
Alpha = 'FORCE'
# Otherwise it is not significative
} else {
fill = 'white'
color = 'grey85'
Alpha = 'FALSE'
}
# Stores info needed to plot
Periods_trend = append(Periods_trend, Periods)
NPeriod_trend = append(NPeriod_trend, j)
Var_trend = append(Var_trend, var)
Type_trend = append(Type_trend, type)
Code_trend = append(Code_trend, code)
Alpha_trend = append(Alpha_trend, Alpha)
TrendValue_trend = append(TrendValue_trend, trendValue)
DataMean_trend = append(DataMean_trend, dataMean)
Fill_trend = append(Fill_trend, fill)
Color_trend = append(Color_trend, color)
}
}
}
# If there is a 'mean_period'
if (!is.null(mean_period)) {
# Convert 'mean_period' to list
mean_period = as.list(mean_period)
# Number of mean period
nPeriod_mean = length(mean_period)
res = short_meanExtremes(list_df2plot, Code, nPeriod_mean, nbp, nCode)
minBreakValue = res$min
maxBreakValue = res$max
} else {
nPeriod_mean = 1
}
# If there is a 'mean_period'
if (!is.null(mean_period)) {
# Blank vectors to store info about breaking analysis
Periods_mean = c()
NPeriod_mean = c()
Var_mean = c()
Type_mean = c()
Code_mean = c()
DataMean_mean = c()
breakValue_mean = c()
# Blank array to store mean for a temporary period in order
# to compute the difference of mean with a second period
dataMeantmp = array(rep(NA, nbp*nCode),
dim=c(nbp, nCode))
# For all period of breaking analysis
for (j in 1:nPeriod_mean) {
# For all the code
for (k in 1:nCode) {
# Gets the code
code = Code[k]
# For all variable
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
for (i in 1:nbp) {
# Extracts the data corresponding to
# the current variable
df_data = list_df2plot[[i]]$data
# Extract the variable of the plot
var = list_df2plot[[i]]$var
# Extract the type of the variable to plot
type = list_df2plot[[i]]$type
# Extracts the data corresponding to the code
df_data_code = df_data[df_data$code == code,]
# Get the current start and end of the sub period
Start_mean = mean_period[[j]][1]
End_mean = mean_period[[j]][2]
# Extract the data corresponding to this sub period
df_data_code_per =
df_data_code[df_data_code$Date >= Start_mean
& df_data_code$Date <= End_mean,]
# Min max for the sub period
Datemin = min(df_data_code_per$Date)
Datemax = max(df_data_code_per$Date)
# Creates a period name
Periods = paste(Datemin, Datemax,
sep=' / ')
# Mean of the flow over the sub period
dataMean = mean(df_data_code_per$Value,
na.rm=TRUE)
# If this in not the first period
if (j > 1) {
# Compute the difference of mean
Break = dataMean - dataMeantmp[i, k]
# Otherwise for the first period
} else {
# Stocks NA
Break = NA
}
# If it is a flow variable
if (type == 'sévérité') {
# Normalises the break by the mean of the
# initial period
breakValue = Break / dataMeantmp[i, k]
# If it is a date variable
} else if (type == 'saisonnalité') {
# Just stocks the break value
breakValue = Break
}
# Stores temporarily the mean of the current period
dataMeantmp[i, k] = dataMean
# Stores info needed to plot
Periods_mean = append(Periods_mean, Periods)
NPeriod_mean = append(NPeriod_mean, j)
Var_mean = append(Var_mean, var)
Type_mean = append(Type_mean, type)
Code_mean = append(Code_mean, code)
DataMean_mean = append(DataMean_mean, dataMean)
breakValue_mean = append(breakValue_mean,
breakValue)
}
}
}
# Blanks vector to store color info
Fill_mean = c()
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
Color_mean = c()
# Index to count over all break computed
ii = 1
for (j in 1:nPeriod_mean) {
# For all the code
for (k in 1:nCode) {
# Gets the code
code = Code[k]
# For all variable
for (i in 1:nbp) {
# Extracts averaged breaking
breakValue = breakValue_mean[ii]
# Gets the color associated
color_res = get_color(breakValue,
minBreakValue[j, i],
maxBreakValue[j, i],
palette_name='perso',
reverse=TRUE)
# Gets the fill and contour color
fill = color_res
color = 'white'
# Stores it
Fill_mean = append(Fill_mean, fill)
Color_mean = append(Color_mean, color)
# Passes to the next index
ii = ii + 1
}
}
}
}
# If the slice option is not specified, the info for all
# stations will be draw on the same page
if (is.null(slice)) {
slice = nCode
}
allType = c()
for (i in 1:nbp) {
allType = c(allType, list_df2plot[[i]]$type)
}
countType = rle(sort(allType))
df_countType = tibble(type=countType$values, n=countType$lengths)
nbpMax = max(df_countType$n)
# Gets all the different type of plots
Type = levels(factor(allType))
nbType = length(Type)
# Number of pages
N_loop = 0
# For all the type of plots
for (itype in 1:nbType) {
# Gets the type
type = Type[itype]
# Extracts each possibilities of hydrological region
RH = rle(sort(df_meta$region_hydro))$values
twoL = names(df_meta$region_hydro)
# Number of different first letters
nRH = length(RH)
# For all the available first letter
for (iR in 1:nRH) {
# Gets the first letter
rh = RH[iR]
okL = rle(sort(twoL[df_meta$region_hydro == rh]))$values
nL = nchar(okL[1])
# Get only station code with the same first letter
subCodeRh = Code[substr(Code, 1, nL) %in% okL]
# Counts the number of station in it
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
nsubCodeRh = length(subCodeRh)
# Computes the number of pages needed to plot
# all stations
nMat = as.integer(nsubCodeRh/slice) + 1
# Counts the number of pages
N_loop = N_loop + nMat
}
}
# For all the type of plots
for (itype in 1:nbType) {
# Gets the type
type = Type[itype]
# Extracts each possibilities of hydrological region
RH = rle(sort(df_meta$region_hydro))$values
twoL = names(df_meta$region_hydro)
# Number of different first letters
nRH = length(RH)
# For all the available first letter
for (iR in 1:nRH) {
# Gets the first letter
rh = RH[iR]
okL = rle(sort(twoL[df_meta$region_hydro == rh]))$values
nL = nchar(okL[1])
# Get only station code with the same first letter
subCodeRh = Code[substr(Code, 1, nL) %in% okL]
# Counts the number of station in it
nsubCodeRh = length(subCodeRh)
# Computes the number of pages needed to
# plot all stations
nMat = as.integer(nsubCodeRh/slice) + 1
# For all the pages
for (iMat in 1:nMat) {
n_loop = iR + nRH*(itype-1) + (iMat-1)
# Print the matrix name
print(paste('Matrix ', iMat, '/', nMat,
' of ', type,
' for region : ', rh,
" (",
round(n_loop / N_loop * 100,
0),
" %)",
sep=''))
# Extracts the station for the current page
subCode = subCodeRh[(slice*(iMat-1)+1):(slice*iMat)]
# Removes NA stations
subCode = subCode[!is.na(subCode)]
# Reverses verticale order of stations
subCode = rev(subCode)
# Gets the number of station for the page
nsubCode = length(subCode)
# Creates logical vector to select only info about
# stations that will be plot on the page
CodeRh_trend =
Code_trend %in% subCode & Type_trend == type
# Extracts those info
subPeriods_trend = Periods_trend[CodeRh_trend]
subNPeriod_trend = NPeriod_trend[CodeRh_trend]
subVar_trend = Var_trend[CodeRh_trend]
subType_trend = Type_trend[CodeRh_trend]
subCode_trend = Code_trend[CodeRh_trend]
subAlpha_trend = Alpha_trend[CodeRh_trend]
subTrendValue_trend = TrendValue_trend[CodeRh_trend]
subDataMean_trend = DataMean_trend[CodeRh_trend]
subFill_trend = Fill_trend[CodeRh_trend]
subColor_trend = Color_trend[CodeRh_trend]
# Same for breaking analysis
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
CodeRh_mean =
Code_mean %in% subCode & Type_mean == type
# Extracts right info
subPeriods_mean = Periods_mean[CodeRh_mean]
subNPeriod_mean = NPeriod_mean[CodeRh_mean]
subVar_mean = Var_mean[CodeRh_mean]
subType_mean = Type_mean[CodeRh_mean]
subCode_mean = Code_mean[CodeRh_mean]
subDataMean_mean = DataMean_mean[CodeRh_mean]
subbreakValue_mean = breakValue_mean[CodeRh_mean]
subFill_mean = Fill_mean[CodeRh_mean]
subColor_mean = Color_mean[CodeRh_mean]
# Gets the number of variable to plot in
# function of the current type
nbpMod =
length(levels(factor(subVar_trend)))
### Plot ###
# Fixes the height and width of the table according to
# the number of station and the number of column to draw
height = nsubCode
# width = nbpMod * 2 * nPeriod_trend + nPeriod_trend + nPeriod_mean * nbpMod + nPeriod_mean + nbpMod
width = nbpMax * 2 * nPeriod_trend + nPeriod_trend + nPeriod_mean * nbpMax + nPeriod_mean + nbpMax
# Fixes the size of the plot area to keep proportion right
options(repr.plot.width=width, repr.plot.height=height)
# Open a new plot with a personalise theme
mat = ggplot() + theme_ash +
# Modification of theme in order to remove axis
theme(
panel.border=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.ticks.x=element_blank(),
axis.title.y=element_blank(),
plot.margin=margin(t=0, r=0, b=0, l=0, unit="mm")
)
colorBack = 'grey94'
radius = 0.43
# Extracts the name of the currently hydrological
# region plotted
title = df_meta[df_meta$code == subCode[1],]$region_hydro
subtitle = paste(type, ' ', iMat, '/', nMat,
sep='')
# Postion and name of the title
xt = 1 - 6
yt = height + 2
Title = bquote(bold(.(title))~'-'~.(subtitle))
# Writes the title
mat = mat +
annotate("text", x=xt, y=yt,
label=Title,
hjust=0, vjust=1,
size=6, color="#00A3A8")
### Trend ###
# For all the trend period
for (j in 1:nPeriod_trend) {
# Extracts the info to plot associated to the
# right period
Periods_trend_per =
subPeriods_trend[subNPeriod_trend == j]
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
NPeriods_trend_per =
subNPeriod_trend[subNPeriod_trend == j]
Var_trend_per =
subVar_trend[subNPeriod_trend == j]
Type_trend_per =
subType_trend[subNPeriod_trend == j]
Code_trend_per =
subCode_trend[subNPeriod_trend == j]
Alpha_trend_per =
subAlpha_trend[subNPeriod_trend == j]
TrendValue_trend_per =
subTrendValue_trend[subNPeriod_trend == j]
DataMean_trend_per =
subDataMean_trend[subNPeriod_trend == j]
Fill_trend_per =
subFill_trend[subNPeriod_trend == j]
Color_trend_per =
subColor_trend[subNPeriod_trend == j]
# Converts the variable list into levels for factor
levels = unlist(subVar_trend[1:nbpMod])
# Converts the vector of hydrological variable to
# a vector of integer associated to those variable
Xtmp = as.integer(factor(as.character(Var_trend_per),
levels=levels))
# Computes X position of the column for
# the period dates
Xc = j + (j - 1)*nbpMod*2
# Computes X positions of columns for
# the mean of variables
Xm = Xtmp + (j - 1)*nbpMod*2 + j
# Computes X positions of columns for
# the averaged trend
X = Xtmp + (j - 1)*nbpMod*2 + nbpMod + j
# Computes Y positions of each line for each station
Y = as.integer(factor(Code_trend_per))
# Reverses vertical order of stations
Y = rev(Y)
# Position of a line to delimite periods
x = Xc - 0.4
xend = X[length(X)] + 0.4
y = height + 1.13
# Drawing of the line
mat = mat +
annotate("segment",
x=x, xend=xend,
y=y, yend=y,
color="grey40", size=0.35)
# Position of the name of the current period
yt = y + 0.15
Start = trend_period[[j]][1]
End = trend_period[[j]][2]
# Name of the period
# periodName =
# bquote(bold('Période')~bold(.(as.character(j))))
if (j == 1) {
periodName = bquote(bold("Analyse de tendance sur la série entière"))
} else if (j == 2) {
periodName = bquote(bold("Analyse de tendance sur la période commune"))
}
# Naming the period
mat = mat +
annotate("text", x=x, y=yt,
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
label=periodName,
hjust=0, vjust=0.5,
size=3.5, color='grey40')
# For all the variable
for (i in 1:length(X)) {
mat = mat +
# Plots circles for averaged trends
gg_circle(r=radius, xc=X[i], yc=Y[i],
fill=Fill_trend_per[i],
color=Color_trend_per[i],
size=0.75) +
# Plots circles for averaged of variables
gg_circle(r=radius, xc=Xm[i], yc=Y[i],
fill=colorBack, color=colorBack,
size=0.75) +
# Plots circles for the column of period dates
gg_circle(r=radius, xc=Xc, yc=Y[i],
fill=colorBack, color=colorBack,
size=0.75)
}
# For all averaged trends on this periods
for (i in 1:length(TrendValue_trend_per)) {
# Extracts the value of the averaged trend
trendValue = TrendValue_trend_per[i]
type = Type_trend_per[i]
# If it is a flow variable
if (type == 'sévérité') {
Nsign_mean = 2
# Converts it to the right format with
# two significant figures
trendValueC = signif(trendValue*100, 2)
# If it is a date variable
} else if (type == 'saisonnalité') {
# Fixes the significants number for mean to 3
Nsign_mean = 3
# Converts the trend value with two
# significant figures
trendValueC = signif(trendValue, 2)
}
# If it is significative
if (Alpha_trend_per[i] == 'TRUE') {
# The text color is white
Tcolor = 'white'
} else if (Alpha_trend_per[i] == 'FORCE') {
Tcolor = Color_trend_per[i]
# Otherwise
} else if (Alpha_trend_per[i] == 'FALSE') {
# The text is grey
Tcolor = 'grey85'
}
# Same for averaged variables over
# the current period
dataMean = DataMean_trend_per[i]
dataMeanC = signif(dataMean, Nsign_mean)
mat = mat +
# Writes the mean trend
annotate('text', x=X[i], y=Y[i],
label=trendValueC,
hjust=0.5, vjust=0.5,
size=3, color=Tcolor) +
# Writes the mean of the associated variable
annotate('text', x=Xm[i], y=Y[i],
label=dataMeanC,
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
hjust=0.5, vjust=0.5,
size=3, color='grey40')
}
# Writes a name for the period dates column
mat = mat +
annotate('text', x=Xc, y=max(Y) + 0.9,
label=bquote(bold('Début')),
hjust=0.5, vjust=0.5,
size=3, color='grey20') +
annotate('text', x=Xc, y=max(Y) + 0.63,
label=bquote(bold('Fin')),
hjust=0.5, vjust=0.5,
size=3, color='grey20')
# For all variable
for (i in 1:nbpMod) {
# Extract the variable of the plot
var = subVar_trend[i]
type = subType_trend[i]
# If it is a flow variable
if (type == 'sévérité') {
# Fixes the unit of the mean and the trend
# for the flow
unit_mean = bquote('['*m^3*'.'*s^{-1}*']')
unit_trend = bquote('[%.'*an^{-1}*']')
# If it is a date variable
} else if (type == 'saisonnalité') {
# Fixes the unit of the mean and the trend
# for the date
unit_mean = bquote('[jour]')
unit_trend = bquote('[jour.'*an^{-1}*']')
}
mat = mat +
# Writes the unit of the variable
annotate('text', x=X[i], y=max(Y) + 0.63,
label=unit_trend,
hjust=0.5, vjust=0.5,
size=2, color='grey40') +
# Writes the type of the variable
annotate('text', x=X[i], y=max(Y) + 0.9,
label=bquote(.(var)),
hjust=0.5, vjust=0.5,
size=3.25, color='grey20') +
# Writes the unit of the averaged variable
annotate('text', x=Xm[i], y=max(Y) + 0.63,
label=unit_mean,
hjust=0.5, vjust=0.5,
size=2, color='grey40') +
# Writes the type of the averaged variable
annotate('text', x=Xm[i], y=max(Y) + 0.9,
label=expr(bar(!!var)),
hjust=0.5, vjust=0.5,
size=3.25, color='grey20')
}
# For all the station on the page
for (k in 1:nsubCode) {
# Gets the code
code = subCode[k]
# Extracts label for the period dates
label =
Periods_trend_per[Code_trend_per == code][1]
# Gets the start and end of the period
# for the station
periodStart = substr(label, 1, 4)
periodEnd = substr(label, 14, 17)
701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770
mat = mat +
# Writes the starting value
annotate('text', x=Xc, y=k + 0.13,
label=bquote(bold(.(periodStart))),
hjust=0.5, vjust=0.5,
size=3, color='grey40') +
# Writes the ending value
annotate('text', x=Xc, y=k - 0.13,
label=bquote(bold(.(periodEnd))),
hjust=0.5, vjust=0.5,
size=3, color='grey40')
}
}
### Mean ###
# For all the trend period
for (j in 1:nPeriod_mean) {
# Extracts the info to plot associated to the
# right period
Periods_mean_per =
subPeriods_mean[subNPeriod_mean == j]
NPeriods_mean_per =
subNPeriod_mean[subNPeriod_mean == j]
Var_mean_per =
subVar_mean[subNPeriod_mean == j]
Type_mean_per =
subType_mean[subNPeriod_mean == j]
Code_mean_per =
subCode_mean[subNPeriod_mean == j]
DataMean_mean_per =
subDataMean_mean[subNPeriod_mean == j]
breakValue_mean_per =
subbreakValue_mean[subNPeriod_mean == j]
Fill_mean_per =
subFill_mean[subNPeriod_mean == j]
Color_mean_per =
subColor_mean[subNPeriod_mean == j]
# Converts the variable list into levels for factor
levels = unlist(subVar_mean[1:nbpMod])
# Converts the vector of hydrological variable to
# a vector of integer associated to those variable
Xtmp_mean =
as.integer(factor(as.character(Var_mean_per),
levels=levels))
# Computes X position of the column for
# the period dates
Xc_mean = j + (j - 1)*nbpMod + X[length(X)]
# Computes X positions of columns for
# the mean of variables
Xm_mean =
Xtmp_mean + (j - 1)*nbpMod + j + X[length(X)]
# Computes X positions of columns for
# the difference of mean between periods (break)
Xr_mean =
Xtmp_mean + (j - 1)*nbpMod*2 + j + X[length(X)]
# Computes Y positions of each line for each station
Y_mean = as.integer(factor(Code_mean_per))
# Reverses vertical order of stations
Y_mean = rev(Y_mean)
# # Position of a line to delimite periods
# x = Xc_mean - 0.4
# xend = Xm_mean[length(Xm_mean)] + 0.25
# y = height + 1.1
# yend = height + 1.1
771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840
# # Drawing of the line
# mat = mat +
# annotate("segment",
# x=x, xend=xend,
# y=y, yend=yend,
# color="grey40", size=0.35)
# # Position of the name of the current period
# yt = y + 0.15
# Start = mean_period[[j]][1]
# End = mean_period[[j]][2]
# # Name of the period
# periodName = bquote(bold('Période')~bold(.(as.character(j+nPeriod_trend))))
# # Naming the period
# mat = mat +
# annotate("text", x=x, y=yt,
# label=periodName,
# hjust=0, vjust=0.5,
# size=3, color='grey40')
# # If this is not the first period
# if (j > 1) {
# # Position of a line to delimite results of
# # difference of mean bewteen periods
# x = Xr_mean[1] - 0.4
# xend = Xr_mean[length(Xr_mean)] + 0.25
# # Drawing of the line
# mat = mat +
# annotate("segment",
# x=x, xend=xend,
# y=y, yend=yend,
# color="grey40", size=0.35)
# # Naming the breaking columns
# breakName = bquote(bold('Écart')~bold(.(as.character(j-1+nPeriod_trend)))*bold('-')*bold(.(as.character(j+nPeriod_trend))))
# # Writes the name
# mat = mat +
# annotate("text", x=x, y=yt,
# label=breakName,
# hjust=0, vjust=0.5,
# size=3, color='grey40')
# }
# Position of a line to delimite periods
if (j == 1) {
x = Xc_mean - 0.4
} else {
x = Xc_mean - 0.5
}
xend = Xm_mean[length(Xm_mean)] + 0.5
y = height + 1.13
# Drawing of the line
mat = mat +
annotate("segment",
x=x, xend=xend,
y=y, yend=y,
color="grey40", size=0.35)
if (j == 1) {
# Position of the name of the current period
yt = y + 0.15
Start = mean_period[[j]][1]
End = mean_period[[j]][2]
# Name of the period
periodName = bquote(bold('Différence entre les moyennes sur périodes de 20 ans '))
# Naming the period
mat = mat +
annotate("text", x=x, y=yt,
label=periodName,
hjust=0, vjust=0.5,
size=3.5, color='grey40')
841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
}
# If this is not the first period
if (j > 1) {
# Position of a line to delimite results of
# difference of mean bewteen periods
x = Xr_mean[1] - 0.5
if (j == nPeriod_mean) {
xend = Xr_mean[length(Xr_mean)] + 0.25
} else {
xend = Xr_mean[length(Xr_mean)] + 0.5
}
# Drawing of the line
mat = mat +
annotate("segment",
x=x, xend=xend,
y=y, yend=y,
color="grey40", size=0.35)
}
# For all the variable
for (i in 1:length(Xm_mean)) {
mat = mat +
# Plots circles for averaged variables
gg_circle(r=radius, xc=Xm_mean[i], yc=Y[i],
fill=colorBack, color=colorBack,
size=0.75) +
# Plots circles for the column of period dates
gg_circle(r=radius, xc=Xc_mean, yc=Y[i],
fill=colorBack, color=colorBack,
size=0.75)
# If this is not the first period
if (j > 1) {
mat = mat +
# Plots circles for breaking results
gg_circle(r=radius, xc=Xr_mean[i],
yc=Y[i],
fill=Fill_mean_per[i],
color=Color_mean_per[i])
}
}
# For all averaged variables on this period
for (i in 1:length(DataMean_mean_per)) {
type = Type_mean_per[i]
# If it is a flow variable
if (type == 'sévérité') {
# The number of significant figures for
# flow mean is 2
Nsign_mean = 2
# If it is a date variable
} else if (type == 'saisonnalité') {
# The number of significant figures for
# date mean is 3
Nsign_mean = 3
}
# Extracts values of averaged variables
dataMean = DataMean_mean_per[i]
# Converts it to the right format with two
# significant figures
dataMeanC = signif(dataMean, Nsign_mean)
# Writes averaged variables values
mat = mat +
911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980
annotate('text', x=Xm_mean[i], y=Y[i],
label=dataMeanC,
hjust=0.5, vjust=0.5,
size=3, color='grey40')
# If this is not the first period
if (j > 1) {
# Extracts values of breaking between periods
breakValue = breakValue_mean_per[i]
# If it is a flow variable
if (type == 'sévérité') {
# Converts it to the right format with two
# significant figures
breakValueC = signif(breakValue*100, 2)
# If it is a date variable
} else if (type == 'saisonnalité') {
# Converts the break value with two
# significant figures
breakValueC = signif(breakValue, 2)
}
# Writes breaking values
mat = mat +
annotate('text', x=Xr_mean[i], y=Y[i],
label=breakValueC,
hjust=0.5, vjust=0.5,
size=3, color='white')
}
}
# Writes a name for the period dates column
mat = mat +
annotate('text', x=Xc_mean, y=max(Y) + 0.9,
label=bquote(bold('Début')),
hjust=0.5, vjust=0.5,
size=3, color='grey20') +
annotate('text', x=Xc_mean, y=max(Y) + 0.63,
label=bquote(bold('Fin')),
hjust=0.5, vjust=0.5,
size=3, color='grey20')
# For all variables
for (i in 1:nbpMod) {
# Extract the variable of the plot
var = subVar_mean[i]
type = subType_mean[i]
# If it is a flow variable
if (type == 'sévérité') {
# Fixes the unit of the mean and the break
# for the flow
unit_mean = bquote('['*m^3*'.'*s^{-1}*']')
unit_break = bquote('[%]')
# If it is a date variable
# Fixes the unit of the mean and the break
# for the date
} else if (type == 'saisonnalité') {
unit_mean = bquote('[jour]')
unit_break = bquote('[jour]')
}
mat = mat +
# Writes the unit of the averaged variable
annotate('text',
x=Xm_mean[i], y=max(Y) + 0.63,
label=unit_mean,
hjust=0.5, vjust=0.5,
size=2, color='grey40') +
# Writes the type of the averaged variable
annotate('text',
x=Xm_mean[i], y=max(Y) + 0.9,
981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050
label=expr(bar(!!var)),
hjust=0.5, vjust=0.5,
size=3.25, color='grey20')
# If this is not the first period
if (j > 1) {
mat = mat +
# Writes the unit of the breaking variable
annotate('text', x=Xr_mean[i],
y=max(Y) + 0.63,
label=unit_break,
hjust=0.5, vjust=0.5,
size=2, color='grey40') +
# Writes the type of the breaking variable
annotate('text', x=Xr_mean[i],
y=max(Y) + 0.9,
label=paste("d", var, sep=''),
hjust=0.5, vjust=0.5,
size=3.25, color='grey20')
}
}
# For all the station on the page
for (k in 1:nsubCode) {
# Gets the code
code = subCode[k]
# Extracts label for the period dates
label = Periods_mean_per[Code_mean_per == code][1]
# Gets the start and end of the period
# for the station
periodStart = substr(label, 1, 4)
periodEnd = substr(label, 14, 17)
mat = mat +
# # Writes the starting value
annotate('text', x=Xc_mean, y=k + 0.13,
label=bquote(bold(.(periodStart))),
hjust=0.5, vjust=0.5,
size=3, color='grey40') +
# Writes the ending value
annotate('text', x=Xc_mean, y=k - 0.13,
label=bquote(bold(.(periodEnd))),
hjust=0.5, vjust=0.5,
size=3, color='grey40')
}
}
### Code ###
# For all the station
for (k in 1:nsubCode) {
# Gets the code
code = subCode[k]
# Gets the name of the station
name = df_meta[df_meta$code == code,]$nom
# Fixes a limit for the max number
# of characters available
ncharMax = 38
# If the number of character of the name is greater
# than the limit
if (nchar(name) > ncharMax) {
# Cuts the name and add '...'
name = paste(substr(name, 1, ncharMax),
'...', sep='')
}
mat = mat +
# Writes the code of the station
annotate('text', x=0.3, y=k + 0.14,
label=bquote(bold(.(code))),
hjust=1, vjust=0.5,
1051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120
size=3.5, color="#00A3A8") +
# Writes the name of the station
annotate('text', x=0.3, y=k - 0.14,
label=name,
hjust=1, vjust=0.5,
size=3.5, color="#00A3A8")
}
### Environment ###
mat = mat +
# Fixed coordinate system
coord_fixed() +
# X axis
scale_x_continuous(limits=c(1 - rel(6),
width + rel(0.5)),
expand=c(0, 0)) +
# Y axis
scale_y_continuous(limits=c(1 - rel(0.5),
height + rel(2)),
expand=c(0, 0))
# Paper format in A3 if needed
if (A3) {
width = 42
height = 29.7
dpi = 300
# Otherwise in A4
} else {
width = 29.7
height = 21
dpi = 100
}
if (!is.null(df_page)) {
section = paste('Tableau récapitulatif de ',
type, sep='')
subsection = title
n_page = df_page$n[nrow(df_page)] + 1
df_page = bind_rows(
df_page,
tibble(section=section,
subsection=subsection,
n=n_page))
}
# If there is a foot note
if (foot_note) {
footName = paste('tableau récapitulatif de ',
type, sep='')
if (is.null(df_page)) {
n_page = n_loop
}
foot = foot_panel(footName,
n_page,
resources_path,
logo_dir,
AEAGlogo_file, INRAElogo_file,
FRlogo_file, foot_height)
# Stores the map, the title and the colorbar
# in a list
P = list(mat, foot)
LM = matrix(c(1,
2),
nrow=2, byrow=TRUE)
} else {
foot_height = 0
# Stores the map, the title and the colorbar
1121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172
# in a list
P = list(mat)
LM = matrix(c(1),
nrow=1, byrow=TRUE)
}
id_foot = 2
LMcol = ncol(LM)
LMrow = nrow(LM)
LM = rbind(rep(99, times=LMcol),
LM, rep(99, times=LMcol))
LMrow = nrow(LM)
LM = cbind(rep(99, times=LMrow),
LM, rep(99, times=LMrow))
LMcol = ncol(LM)
margin_size = 0.5
row_height = (height - 2*margin_size - foot_height) / (LMrow - 3)
Hcut = LM[, 2]
heightLM = rep(row_height, times=LMrow)
heightLM[Hcut == id_foot] = foot_height
heightLM[Hcut == 99] = margin_size
col_width = (width - 2*margin_size) / (LMcol - 2)
Wcut = LM[(nrow(LM)-1),]
widthLM = rep(col_width, times=LMcol)
widthLM[Wcut == 99] = margin_size
# Arranges the graphical object
plot = grid.arrange(grobs=P, layout_matrix=LM,
heights=heightLM, widths=widthLM)
# Saving
ggsave(plot=plot,
path=outdirTmp,
filename=paste(outnameTmp,
'_', type,
'_', rh,
iMat, sep=''),
device='pdf',
width=width, height=height,
units='cm', dpi=dpi)
}
}
}
return (df_page)
}