Newer
Older
#
# *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
# 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, slice=NULL, outdirTmp='', outnameTmp='matrix', title=NULL, A3=FALSE) {
nbp = length(list_df2plot)
# Get all different stations code
df_trend = list_df2plot[[1]]$trend
# Convert 'trend_period' to list
trend_period = as.list(trend_period)
# Number of trend period
nPeriod_trend = length(trend_period)
# Fix the maximal number of period to the minimal possible
# Extract start and end of trend periods
Start = df_trend_code$period_start
# Get the name of the different period
UStart = levels(factor(Start))
# Compute the max of different start and end
# so the number of different period
# If the number of period for the trend is greater
# than the current max period, stocks it
if (nPeriod > nPeriod_max) {
nPeriod_max = nPeriod
}
}
Start_code = vector(mode='list', length=nCode)
End_code = vector(mode='list', length=nCode)
Code_code = vector(mode='list', length=nCode)
Periods_code = vector(mode='list', length=nCode)
Start = df_trend_code$period_start
End = df_trend_code$period_end
# Get the name of the different period
UStart = levels(factor(Start))
# Compute the max of different start and end
# so the number of different period
nPeriod = max(length(UStart), length(UEnd))
# Vector to store trend period
Periods = append(Periods,
paste(Start[i],
End[i],
sep=' / '))
}
Start_code[[j]] = Start
End_code[[j]] = End
Code_code[[j]] = code
Periods_code[[j]] = Periods
}
# Blank array to store mean of the trend for each
# station, perdiod and variable
TrendMean_code = array(rep(1, nPeriod_trend*nbp*nCode),
dim=c(nPeriod_trend, nbp, nCode))
# Extracts the data corresponding to the
# current variable
# Extracts the trend corresponding to the
# current variable
df_trend = list_df2plot[[i]]$trend
p_threshold = list_df2plot[[i]]$p_threshold
# Extracts the data corresponding to the code
df_data_code = df_data[df_data$code == code,]
# Extracts the trend corresponding to the code
Start = Start_code[Code_code == code][[1]][j]
End = End_code[Code_code == code][[1]][j]
Periods = Periods_code[Code_code == code][[1]][j]
df_data_code_per =
df_data_code[df_data_code$Date >= Start
& df_data_code$Date <= End,]
df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start
& df_trend_code$period_end == End,]
# If there is more than one trend on the same period
# Normalises the trend value by the mean of the data
# Computes the min and the max of the mean trend for
# all the station
minTrendMean = apply(TrendMean_code, c(1, 2), min, na.rm=TRUE)
maxTrendMean = apply(TrendMean_code, c(1, 2), max, na.rm=TRUE)
Code_trend = c()
Pthresold_trend = c()
TrendMean_trend = c()
DataMean_trend = c()
Fill_trend = c()
Color_trend = c()
# Extracts the data corresponding to the current variable
# Extracts the trend corresponding to the
# current variable
df_trend = list_df2plot[[i]]$trend
p_threshold = list_df2plot[[i]]$p_threshold
# 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
Start = Start_code[Code_code == code][[1]][j]
End = End_code[Code_code == code][[1]][j]
Periods = Periods_code[Code_code == code][[1]][j]
df_data_code_per =
df_data_code[df_data_code$Date >= Start
& df_data_code$Date <= End,]
df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start
& df_trend_code$period_end == End,]
# If there is more than one trend on the same period
# Normalises the trend value by the mean of the data
color_res = get_color(trendMean,
minTrendMean[j, i],
maxTrendMean[j, i],
palette_name='perso',
reverse=TRUE)
# Specifies the color fill and contour of
# table cells
fill = color_res
color = 'white'
Pthresold = p_thresold
} else {
fill = 'white'
color = 'grey85'
Pthresold = NA
}
Periods_trend = append(Periods_trend, Periods)
NPeriod_trend = append(NPeriod_trend, j)
Code_trend = append(Code_trend, code)
Pthresold_trend = append(Pthresold_trend, Pthresold)
TrendMean_trend = append(TrendMean_trend, trendMean)
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)) {
# Blank vectors to store info about breaking analysis
Code_mean = c()
DataMean_mean = c()
BreakMean_mean = c()
# Convert 'mean_period' to list
mean_period = as.list(mean_period)
# Number of mean period
nPeriod_mean = length(mean_period)
# Blank array to store difference of mean between two periods
BreakMean_code = array(rep(1, nPeriod_mean*nbp*nCode),
dim=c(nPeriod_mean, nbp, nCode))
# 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))
# Extracts the data corresponding to
# the current variable
# Extract the type of the variable to plot
type = list_df2plot[[i]]$type
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,]
Datemin = min(df_data_code_per$Date)
Datemax = max(df_data_code_per$Date)
Periods = paste(Datemin, Datemax,
sep=' / ')
# Mean of the flow over the sub period
# Normalises the break by the mean of the
# initial period
# Stores temporarily the mean of the current period
Periods_mean = append(Periods_mean, Periods)
NPeriod_mean = append(NPeriod_mean, j)
Code_mean = append(Code_mean, code)
DataMean_mean = append(DataMean_mean, dataMean)
BreakMean_mean = append(BreakMean_mean,
BreakMean)
}
}
}
# Computes the min and the max of the averaged trend for
minBreakMean = apply(BreakMean_code, c(1, 2),
min, na.rm=TRUE)
maxBreakMean = apply(BreakMean_code, c(1, 2),
max, na.rm=TRUE)
color_res = get_color(BreakMean,
minBreakMean[j, i],
maxBreakMean[j, i],
palette_name='perso',
reverse=TRUE)
Fill_mean = append(Fill_mean, fill)
Color_mean = append(Color_mean, color)
# If the slice option is not specified, the info for all
# stations will be draw on the same page
Type = levels(factor(Type_trend)) ####
# Extracts each possibilities of first letter of station code
# Number of different first letters
nfL = length(firstLetter)
for (ifL in 1:nfL) {
# Gets the first letter
fL = firstLetter[ifL]
# Get only station code with the same first letter
subCodefL = Code[substr(Code, 1, 1) == fL]
# Computes the number of pages needed to plot all stations
# Reverses verticale order of stations
subCode = rev(subCode)
# Creates logical vector to select only info about
# stations that will be plot on the page
subPeriods_trend = Periods_trend[CodefL_trend]
subNPeriod_trend = NPeriod_trend[CodefL_trend]
subCode_trend = Code_trend[CodefL_trend]
subPthresold_trend = Pthresold_trend[CodefL_trend]
subTrendMean_trend = TrendMean_trend[CodefL_trend]
subDataMean_trend = DataMean_trend[CodefL_trend]
subFill_trend = Fill_trend[CodefL_trend]
subColor_trend = Color_trend[CodefL_trend]
subPeriods_mean = Periods_mean[CodefL_mean]
subNPeriod_mean = NPeriod_mean[CodefL_mean]
subCode_mean = Code_mean[CodefL_mean]
subDataMean_mean = DataMean_mean[CodefL_mean]
subBreakMean_mean = BreakMean_mean[CodefL_mean]
subFill_mean = Fill_mean[CodefL_mean]
subColor_mean = Color_mean[CodefL_mean]
# Extracts the name of the currently hydrological
# region plotted
title = df_meta[df_meta$code == subCode[1],]$region_hydro
# Fixes the height and width of the table according to
# the number of station and the number of column to draw
height = nsubCode
width = nbp * 2 * nPeriod_trend + nPeriod_trend + nPeriod_mean * nbp + nPeriod_mean + nbp
# Fixes the size of the plot area to keep proportion right
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=5, r=5, b=5, l=5, unit="mm")
)
xt = 1 - 6
yt = height + 2
Title = bquote(bold(.(title)))
mat = mat +
annotate("text", x=xt, y=yt,
label=Title,
hjust=0, vjust=1,
size=6, color="#00A3A8")
### Trend ###
# Extracts the info to plot associated to the
# right period
Periods_trend_per =
subPeriods_trend[subNPeriod_trend == j]
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]
Pthresold_trend_per =
subPthresold_trend[subNPeriod_trend == j]
TrendMean_trend_per =
subTrendMean_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(Var_trend_per)
# 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
# Computes X positions of columns for the averaged trend
# Computes Y positions of each line for each station
# Reverses vertical order of stations
Y = rev(Y)
mat = mat +
annotate("segment",
x=x, xend=xend,
y=y, yend=yend,
color="grey40", size=0.35)
yt = y + 0.15
Start = trend_period[[j]][1]
End = trend_period[[j]][2]
periodName = bquote(bold('Période')~bold(.(as.character(j))))
mat = mat +
annotate("text", x=x, y=yt,
label=periodName,
hjust=0, vjust=0.5,
size=3, color='grey40')
gg_circle(r=0.45, xc=X[i], yc=Y[i],
fill=Fill_trend_per[i],
color=Color_trend_per[i]) +
gg_circle(r=0.45, xc=Xm[i], yc=Y[i],
fill='white', color='grey40') +
gg_circle(r=0.45, xc=Xc, yc=Y[i],
fill='white', color='grey40')
}
# Converts it to the right format with two
# significant figures
trendMeanC = signif(trendMean*100, 2)
# the current period
dataMean = DataMean_trend_per[i]
dataMeanC = signif(dataMean, 2)
annotate('text', x=Xc, y=max(Y) + 0.9,
label=bquote(bold('Début')),
label=bquote(bold('Fin')),
hjust=0.5, vjust=0.5,
size=3, color='grey20')
label=bquote('[%.'*ans^{-1}*']'),
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)),
label=bquote('['*m^3*'.'*s^{-1}*']'),
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')
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)
mat = mat +
annotate('text', x=Xc, y=k + 0.13,
label=bquote(bold(.(periodStart))),
hjust=0.5, vjust=0.5,
size=3, color='grey40') +
annotate('text', x=Xc, y=k - 0.13,
label=bquote(bold(.(periodEnd))),
hjust=0.5, vjust=0.5,
size=3, color='grey40')
}
}
### 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]
Type_mean_per =
subType_mean[subNPeriod_mean == j]
Code_mean_per =
subCode_mean[subNPeriod_mean == j]
DataMean_mean_per =
subDataMean_mean[subNPeriod_mean == j]
BreakMean_mean_per =
subBreakMean_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(Var_mean_per)
# 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
# Computes X positions of columns for the mean of
# variables
# Computes X positions of columns for the difference of
# mean between periods (break)
# Computes Y positions of each line for each station
# Reverses vertical order of stations
Y_mean = rev(Y_mean)
mat = mat +
annotate("segment",
x=x, xend=xend,
y=y, yend=yend,
color="grey40", size=0.35)
yt = y + 0.15
Start = mean_period[[j]][1]
End = mean_period[[j]][2]
periodName = bquote(bold('Période')~bold(.(as.character(j+nPeriod_trend))))
mat = mat +
annotate("text", x=x, y=yt,
label=periodName,
hjust=0, vjust=0.5,
size=3, color='grey40')
# 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
mat = mat +
annotate("segment",
x=x, xend=xend,
y=y, yend=yend,
color="grey40", size=0.35)
breakName = bquote(bold('Écart')~bold(.(as.character(j-1+nPeriod_trend)))*bold('-')*bold(.(as.character(j+nPeriod_trend))))
mat = mat +
annotate("text", x=x, y=yt,
label=breakName,
hjust=0, vjust=0.5,
size=3, color='grey40')
}
gg_circle(r=0.45, xc=Xm_mean[i], yc=Y[i],
fill='white', color='grey40') +
gg_circle(r=0.45, xc=Xc_mean, yc=Y[i],
fill='white', color='grey40')
gg_circle(r=0.45, xc=Xr_mean[i], yc=Y[i],
fill=Fill_mean_per[i],
color=Color_mean_per[i])
}
}
# Extracts values of averaged variables
dataMean = DataMean_mean_per[i]
# Converts it to the right format with two
# significant figures
dataMeanC = signif(dataMean, 2)
# Writes averaged variables values
# Converts it to the right format with two
# significant figures
BreakMeanC = signif(BreakMean*100, 2)
# Writes breaking values
annotate('text', x=Xc_mean, y=max(Y) + 0.9,
label=bquote(bold('Début')),
label=bquote(bold('Fin')),
hjust=0.5, vjust=0.5,
size=3, color='grey20')
label=bquote('['*m^3*'.'*s^{-1}*']'),
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,
label=expr(bar(!!var)),
hjust=0.5, vjust=0.5,
size=3.25, color='grey20')
# Writes the unit of the breaking variable
annotate('text', x=Xr_mean[i],
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')
# Gets the start and end of the period
# for the station
periodStart = substr(label, 1, 4)
periodEnd = substr(label, 14, 17)
mat = mat +
annotate('text', x=Xc_mean, y=k + 0.13,
label=bquote(bold(.(periodStart))),
hjust=0.5, vjust=0.5,
size=3, color='grey40') +
annotate('text', x=Xc_mean, y=k - 0.13,
label=bquote(bold(.(periodEnd))),
hjust=0.5, vjust=0.5,
size=3, color='grey40')
}
}
### Code ###
# Fixes a limit for the max number
# of characters available
# If the number of character of the name is greater
# than the limit
# Cuts the name and add '...'
name = paste(substr(name, 1, ncharMax),
'...', sep='')
annotate('text', x=0.3, y=k + 0.14,
label=bquote(bold(.(code))),
hjust=1, vjust=0.5,
size=3.5, color="#00A3A8") +
annotate('text', x=0.3, y=k - 0.14,
label=name,
hjust=1, vjust=0.5,
size=3.5, color="#00A3A8")
}
### Environment ###
mat = mat +
scale_x_continuous(limits=c(1 - rel(6),
width + rel(0.5)),
expand=c(0, 0)) +
scale_y_continuous(limits=c(1 - rel(0.5),
height + rel(2)),
expand=c(0, 0))
} else {
width = 29.7
height = 21
dpi = 100
}
width=width, height=height,
units='cm', dpi=dpi)