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 code
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
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