Commit 4e58b039 authored by Heraut Louis's avatar Heraut Louis
Browse files

matrix pimp

parent eabed41b
No related merge requests found
Showing with 333 additions and 226 deletions
+333 -226
......@@ -31,11 +31,11 @@ source('processing/analyse.R', encoding='UTF-8') # hydrograph
source('plotting/shortcut.R', encoding='UTF-8')
## 1. DATASHEET PANEL ________________________________________________
## 1. DATASHEET PANEL MANAGER ________________________________________
# Manages datasheets creations for all stations. Makes the call to
# the different headers, trend analysis graphs and realises arranging
# every plots.
datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, info_header, time_header, foot_note, layout_matrix, info_height, time_ratio, var_ratio, foot_height, resources_path, logo_dir, AEAGlogo_file, INRAElogo_file, FRlogo_file, outdirTmp, df_page=NULL) {
datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, colorForce, info_header, time_header, foot_note, layout_matrix, info_height, time_ratio, var_ratio, foot_height, resources_path, logo_dir, AEAGlogo_file, INRAElogo_file, FRlogo_file, outdirTmp, df_page=NULL) {
# The percentage of augmentation and diminution of the min
# and max limits for y axis
......@@ -55,7 +55,7 @@ datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, in
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)
res = short_trendExtremes(list_df2plot, Code, nPeriod_trend, nbp, nCode, colorForce)
minTrendValue = res$min
maxTrendValue = res$max
}
......@@ -179,7 +179,8 @@ datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, in
max(time_header_code$Date))
# Gets the time serie plot
Htime = time_panel(time_header_code, df_trend_code=NULL,
trend_period=trend_period, missRect=TRUE,
trend_period=trend_period,
axis_xlim=axis_xlim, missRect=TRUE,
unit2day=365.25, var='Q', type='sévérité',
grid=TRUE, ymin_lim=0,
NspaceMax=NspaceMax[k],
......@@ -197,7 +198,7 @@ datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, in
# Extracts the trend corresponding to the
# current variable
df_trend = list_df2plot[[i]]$trend
alpha = list_df2plot[[i]]$alpha
unit2day = list_df2plot[[i]]$unit2day
missRect = list_df2plot[[i]]$missRect
# Extract the variable of the plot
......@@ -216,6 +217,7 @@ datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, in
for (j in 1:nPeriod_trend) {
# If the trend is significant
# if (df_trend_code$p[j] <= alpha | colorForce){
if (df_trend_code$p[j] <= alpha){
# Extract start and end of trend periods
Start = df_trend_code$period_start[j]
......@@ -259,10 +261,11 @@ datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, in
reverse=TRUE)
# Stores it temporarily
colortmp = color_res
# Otherwise
} else {
# Stores the default grey color
colortmp = paste('grey85', sep='')
colortmp = 'grey85'
}
# Stores the color
......@@ -289,7 +292,7 @@ datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, in
# Computes the time panel associated to the current variable
p = time_panel(df_data_code, df_trend_code, var=var,
type=type, alpha=alpha,
type=type, alpha=alpha, colorForce=colorForce,
missRect=missRect, trend_period=trend_period,
mean_period=mean_period, axis_xlim=axis_xlim,
unit2day=unit2day, grid=grid,
......@@ -411,9 +414,9 @@ datasheet_panel = function (list_df2plot, df_meta, trend_period, mean_period, in
}
## 2. OTHER PANEL FOR THE DATASHEET __________________________________
## 2. PANEL FOR THE DATASHEET __________________________________
### 2.1. Time panel __________________________________________________
time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRect=FALSE, unit2day=365.25, trend_period=NULL, mean_period=NULL, axis_xlim=NULL, grid=TRUE, ymin_lim=NULL, color=NULL, NspaceMax=NULL, first=FALSE, last=FALSE, lim_pct=10) {
time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, colorForce=FALSE, missRect=FALSE, unit2day=365.25, trend_period=NULL, mean_period=NULL, axis_xlim=NULL, grid=TRUE, ymin_lim=NULL, color=NULL, NspaceMax=NULL, first=FALSE, last=FALSE, lim_pct=10) {
# Compute max and min of flow
maxQ = max(df_data_code$Value, na.rm=TRUE)
......@@ -547,31 +550,8 @@ time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRe
theme(plot.margin=margin(t=2, r=0, b=2, l=0, unit="mm"))
}
## Sub period background ##
if (!is.null(trend_period)) {
# trend_period = as.list(trend_period)
# Imin = 10^99
# for (per in trend_period) {
# I = interval(per[1], per[2])
# if (I < Imin) {
# Imin = I
# trend_period_min = as.Date(per)
# }
# }
# p = p +
# geom_rect(aes(xmin=min(df_data_code$Date),
# ymin=0,
# xmax=trend_period_min[1],
# ymax= maxQ*1.1),
# linetype=0, fill='grey97') +
# geom_rect(aes(xmin=trend_period_min[2],
# ymin=0,
# xmax=max(df_data_code$Date),
# ymax= maxQ*1.1),
# linetype=0, fill='grey97')
# Convert trend period to list if it is not
trend_period = as.list(trend_period)
......@@ -592,39 +572,35 @@ time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRe
minPer = trend_period_min[1]
maxPer = trend_period_min[2]
# If it is not a flow or sqrt of flow time serie
if (var != 'sqrt(Q)' & var != 'Q') {
# If there is an 'axis_lim'
if (!is.null(axis_xlim)) {
# If the temporary start of period is smaller
# than the fix start of x axis limit
if (minPer < axis_xlim[1]) {
# Set the start of the period to the start of
# the x axis limit
minPer = axis_xlim[1]
}
}
}
# If it is not a flow or sqrt of flow time serie
if (var != 'sqrt(Q)' & var != 'Q') {
# If there is an 'axis_lim'
if (!is.null(axis_xlim)) {
# If the temporary end of period plus one year
# is smaller than the fix end of x axis limit
if (maxPer + years(1) < axis_xlim[2]) {
# Add one year the the temporary end of period
maxPer = maxPer + years(1)
} else {
# Set the start of the period to the start of
# the x axis limit
maxPer = axis_xlim[2]
}
# If there is an 'axis_lim'
if (!is.null(axis_xlim)) {
# If the temporary start of period is smaller
# than the fix start of x axis limit
if (minPer < axis_xlim[1]) {
# Set the start of the period to the start of
# the x axis limit
minPer = axis_xlim[1]
}
# If the temporary end of period plus one year
# is smaller than the fix end of x axis limit
if (maxPer + years(1) < axis_xlim[2]) {
# Add one year the the temporary end of period
# if there is no 'axis_lim'
maxPer = maxPer + years(1)
} else {
maxPer = maxPer + years(1)
# Set the start of the period to the start of
# the x axis limit
maxPer = axis_xlim[2]
}
# If there is no 'axis_lim'
} else {
if (minPer < min(df_data_code$Date)) {
minPer = min(df_data_code$Date)
}
if (maxPer > max(df_data_code$Date)) {
maxPer = max(df_data_code$Date)
}
}
......@@ -990,9 +966,33 @@ time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRe
trend = df_trend_code_per$trend
# Gets the p value
pVal = df_trend_code_per$p
# Converts it to character
pValC = as.character(format(round(pVal, 2),
nsmall=2))
# if (colorForce) {
# if (pVal <= alpha) {
# colorLine = color[i]
# colorLabel = color[i]
# } else {
# colorLine = color[i]
# colorLabel = 'grey85'
# }
# } else {
# if (pVal <= alpha) {
# colorLine = color[i]
# colorLabel = color[i]
# } else {
# colorLine = 'grey85'
# colorLabel = 'grey85'
# }
# }
if (pVal <= alpha) {
colorLine = color[i]
colorLabel = color[i]
} else {
colorLine = 'grey85'
colorLabel = 'grey85'
}
# Computes the mean trend
trendMean = trend/dataMean
# Computes the magnitude of the trend
......@@ -1034,11 +1034,12 @@ time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRe
leg_trendtmp = tibble(x=x, xend=xend,
y=y, yend=yend,
xt=xt,
colorLine=colorLine,
colorLabel=colorLabel,
trendC=trendC,
powerC=powerC,
spaceC=spaceC,
trendMeanC=trendMeanC,
pValC=pValC,
xminR=xminR, yminR=yminR,
xmaxR=xmaxR, ymaxR=ymaxR,
period=i)
......@@ -1059,19 +1060,14 @@ time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRe
xmax=xmaxR,
ymax=ymaxR),
linetype=0, fill='white', alpha=0.5)
}
# For all periods
for (i in 1:nPeriod_trend) {
# Extract the trend of the current sub period
leg_trend_per = leg_trend[leg_trend$period == i,]
# Get the character variable for naming the trend
colorLine = leg_trend_per$colorLine
colorLabel = leg_trend_per$colorLabel
trendC = leg_trend_per$trendC
powerC = leg_trend_per$powerC
spaceC = leg_trend_per$spaceC
trendMeanC = leg_trend_per$trendMeanC
pValC = leg_trend_per$pValC
# If it is a flow variable
if (type == 'sévérité') {
......@@ -1089,7 +1085,7 @@ time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRe
annotate("segment",
x=leg_trend_per$x, xend=leg_trend_per$xend,
y=leg_trend_per$y, yend=leg_trend_per$yend,
color=color[i],
color=colorLine,
linetype='solid',
lwd=0.8) +
......@@ -1097,7 +1093,7 @@ time_panel = function (df_data_code, df_trend_code, var, type, alpha=0.1, missRe
label=label, size=2.8,
x=leg_trend_per$xt, y=leg_trend_per$y,
hjust=0, vjust=0.5,
color=color[i])
color=colorLabel)
}
# For all periods
......
......@@ -131,7 +131,8 @@ datasheet_layout = function (df_data, df_meta, layout_matrix,
variable='', df_trend=NULL,
alpha=0.1, unit2day=365.25, var='',
type='', glose=NULL, trend_period=NULL,
mean_period=NULL, axis_xlim=NULL,
mean_period=NULL, colorForce=FALSE,
axis_xlim=NULL,
missRect=TRUE, time_header=NULL,
info_header=NULL, foot_note=TRUE,
info_height=2.8, time_ratio=2,
......@@ -251,6 +252,7 @@ datasheet_layout = function (df_data, df_meta, layout_matrix,
idPer_trend=length(trend_period),
trend_period=trend_period,
mean_period=mean_period,
colorForce=colorForce,
df_shapefile=df_shapefile,
foot_note=foot_note,
foot_height=foot_height,
......@@ -269,6 +271,7 @@ datasheet_layout = function (df_data, df_meta, layout_matrix,
df_meta,
trend_period,
mean_period,
colorForce=colorForce,
slice=19,
outdirTmp=outdirTmp,
A3=TRUE,
......@@ -288,6 +291,7 @@ datasheet_layout = function (df_data, df_meta, layout_matrix,
df_meta,
trend_period=trend_period,
mean_period=mean_period,
colorForce=colorForce,
info_header=info_header,
time_header=time_header,
foot_note=foot_note,
......
......@@ -29,8 +29,8 @@
## 1. MAP PANEL ______________________________________________________
# Generates a map plot of the tendancy of a hydrological variable
map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
trend_period,
mean_period, outdirTmp='', codeLight=NULL,
trend_period, mean_period, colorForce=FALSE,
outdirTmp='', codeLight=NULL,
margin=NULL, showSea=TRUE,
foot_note=FALSE,
foot_height=0, resources_path=NULL,
......@@ -59,7 +59,7 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
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)
res = short_trendExtremes(list_df2plot, Code, nPeriod_trend, nbp, nCode, colorForce)
minTrendValue = res$min
maxTrendValue = res$max
}
......@@ -298,13 +298,13 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
value = breakValue_code[j, i, k]
minValue = minBreakValue[j, i]
maxValue = maxBreakValue[j, i]
pvalue = 0
pVal = 0
} else if (is.null(trend_period)) {
value = NA
minValue = NULL
maxValue = NULL
pvalue = 0
pVal = 0
} else {
......@@ -358,7 +358,7 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
minValue = minTrendValue[idPer_trend, i]
maxValue = maxTrendValue[idPer_trend, i]
pvalue = df_trend_code_per$p
pVal = df_trend_code_per$p
}
......@@ -385,7 +385,7 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
} else {
# If it is significative
if (pvalue <= alpha){
if (pVal <= alpha){
# The computed color is stored
filltmp = color_res
# If the mean tend is positive
......@@ -399,7 +399,12 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
# of the marker
shapetmp = 25
}
# If it is not significative
} else if (pVal > alpha & colorForce) {
# The computed color is stored
filltmp = color_res
# The marker is a circle
shapetmp = 21
# If it is not significative
} else {
# The fill color is grey
filltmp = 'grey97'
......@@ -421,7 +426,7 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
shape = c(shape, shapetmp)
Value = c(Value, value)
# If the trend analysis is significative a TRUE is stored
OkVal = c(OkVal, pvalue <= alpha)
OkVal = c(OkVal, pVal <= alpha)
}
# Creates a tibble to stores all the data to plot
plot_map = tibble(lon=lon, lat=lat, fill=fill,
......@@ -709,7 +714,7 @@ map_panel = function (list_df2plot, df_meta, df_shapefile, idPer_trend=1,
}
# Takes only the significative ones
yValue = yValue[OkVal]
yValueOk = yValue[OkVal]
# Histogram distribution
# Computes the histogram of values
......
......@@ -28,7 +28,9 @@
## 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, slice=NULL, outdirTmp='', outnameTmp='matrix', title=NULL, A3=FALSE,
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,
......@@ -48,7 +50,7 @@ matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period, slice
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)
res = short_trendExtremes(list_df2plot, Code, nPeriod_trend, nbp, nCode, colorForce)
minTrendValue = res$min
maxTrendValue = res$max
......@@ -124,24 +126,34 @@ matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period, slice
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 (df_trend_code_per$p <= alpha){
# Gets the color associated to the averaged trend
color_res = get_color(trendValue,
minTrendValue[j, i],
maxTrendValue[j, i],
palette_name='perso',
reverse=TRUE)
if (pVal <= alpha){
# Specifies the color fill and contour of
# table cells
fill = color_res
color = 'white'
Alpha = TRUE
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
Alpha = 'FALSE'
}
# Stores info needed to plot
......@@ -449,6 +461,9 @@ matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period, slice
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
......@@ -518,42 +533,51 @@ matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period, slice
# Position of a line to delimite periods
x = Xc - 0.4
xend = X[length(X)] + 0.4
y = height + 1.1
yend = height + 1.1
y = height + 1.13
# Drawing of the line
mat = mat +
annotate("segment",
x=x, xend=xend,
y=y, yend=yend,
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))))
# 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,
label=periodName,
hjust=0, vjust=0.5,
size=3, color='grey40')
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=0.45, xc=X[i], yc=Y[i],
gg_circle(r=radius, xc=X[i], yc=Y[i],
fill=Fill_trend_per[i],
color=Color_trend_per[i]) +
color=Color_trend_per[i],
size=0.75) +
# Plots circles for averaged of variables
gg_circle(r=0.45, xc=Xm[i], yc=Y[i],
fill='white', color='grey40') +
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=0.45, xc=Xc, yc=Y[i],
fill='white', color='grey40')
gg_circle(r=radius, xc=Xc, yc=Y[i],
fill=colorBack, color=colorBack,
size=0.75)
}
# For all averaged trends on this periods
......@@ -578,11 +602,14 @@ matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period, slice
}
# If it is significative
if (Alpha_trend_per[i]) {
if (Alpha_trend_per[i] == 'TRUE') {
# The text color is white
Tcolor = 'white'
# Otherwise
} else {
} 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'
}
......@@ -732,69 +759,128 @@ matrix_panel = function (list_df2plot, df_meta, trend_period, mean_period, slice
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
# # 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
x = Xc_mean - 0.4
xend = Xm_mean[length(Xm_mean)] + 0.25
y = height + 1.1
yend = height + 1.1
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=yend,
y=y, yend=y,
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 (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')
}
# 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
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=yend,
y=y, yend=y,
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')
}
# For all the variable
for (i in 1:length(Xm_mean)) {
mat = mat +
# Plots circles for averaged variables
gg_circle(r=0.45, xc=Xm_mean[i], yc=Y[i],
fill='white', color='grey40') +
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=0.45, xc=Xc_mean, yc=Y[i],
fill='white', color='grey40')
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=0.45, xc=Xr_mean[i], yc=Y[i],
gg_circle(r=radius, xc=Xr_mean[i],
yc=Y[i],
fill=Fill_mean_per[i],
color=Color_mean_per[i])
}
......
......@@ -25,7 +25,7 @@
## 1. EXTREMES OF VALUE FOR ALL STATION ______________________________
### 1.1. Trend _______________________________________________________
short_trendExtremes = function (list_df2plot, Code, nPeriod_trend, nbp, nCode) {
short_trendExtremes = function (list_df2plot, Code, nPeriod_trend, nbp, nCode, colorForce=FALSE) {
# Blank array to store mean of the trend for each
# station, perdiod and variable
......@@ -48,7 +48,6 @@ short_trendExtremes = function (list_df2plot, Code, nPeriod_trend, nbp, nCode) {
df_trend = list_df2plot[[i]]$trend
# Extracts the type of the variable
type = list_df2plot[[i]]$type
alpha = list_df2plot[[i]]$alpha
# Extracts the data corresponding to the code
df_data_code = df_data[df_data$code == code,]
df_trend_code = df_trend[df_trend$code == code,]
......@@ -87,7 +86,7 @@ short_trendExtremes = function (list_df2plot, Code, nPeriod_trend, nbp, nCode) {
}
# If the p value is under the threshold
if (df_trend_code_per$p <= alpha) {
if (df_trend_code_per$p <= alpha | colorForce) {
# Stores the mean trend
TrendValue_code[j, i, k] = trendValue
# Otherwise
......
......@@ -30,6 +30,7 @@
# between the min and the max of the variable
get_color = function (value, min, max, ncolor=256, palette_name='perso', reverse=FALSE) {
# If the value is a NA return NA color
if (is.na(value)) {
return (NA)
......@@ -65,16 +66,25 @@ get_color = function (value, min, max, ncolor=256, palette_name='perso', reverse
# If the value is negative
if (value < 0) {
# Gets the relative position of the value in respect
# to its span
idNorm = (value + maxAbs) / maxAbs
if (maxAbs == 0) {
idNorm = 0
} else {
# Gets the relative position of the value in respect
# to its span
idNorm = (value + maxAbs) / maxAbs
}
# The index corresponding
id = round(idNorm*(ncolor - 1) + 1, 0)
id = round(idNorm*(ncolor - 1) + 1, 0)
# The associated color
color = palette_cold[id]
# Same if it is a positive value
} else {
idNorm = value / maxAbs
if (maxAbs == 0) {
idNorm = 0
} else {
idNorm = value / maxAbs
}
id = round(idNorm*(ncolor - 1) + 1, 0)
color = palette_hot[id]
}
......
......@@ -128,7 +128,8 @@ get_QAtrend = function (df_data, df_meta, period, alpha, yearLac_day, df_mod=tib
na.rm=TRUE)
# Compute the trend analysis
df_QAtrend = Estimate.stats(data.extract=df_QAEx,
level=alpha)
level=alpha,
dep.option='AR1')
# Get the associated time interval
I = interval(per[1], per[2])
......@@ -204,7 +205,8 @@ get_QMNAtrend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_d
na.rm=TRUE)
# Compute the trend analysis
df_QMNAtrend = Estimate.stats(data.extract=df_QMNAEx,
level=alpha)
level=alpha,
dep.option='AR1')
# Get the associated time interval
I = interval(per[1], per[2])
......@@ -308,7 +310,8 @@ get_VCN10trend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_
na.rm=TRUE)
# Compute the trend analysis
df_VCN10trend = Estimate.stats(data.extract=df_VCN10Ex,
level=alpha)
level=alpha,
dep.option='AR1')
# Get the associated time interval
I = interval(per[1], per[2])
......@@ -494,7 +497,8 @@ get_tDEBtrend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_d
# Compute the trend analysis
df_tDEBtrend = Estimate.stats(data.extract=df_tDEBEx,
level=alpha)
level=alpha,
dep.option='AR1')
# Get the associated time interval
I = interval(per[1], per[2])
......@@ -572,7 +576,8 @@ get_tCENtrend = function (df_data, df_meta, period, alpha, sampleSpan, yearLac_d
# Compute the trend analysis
df_tCENtrend = Estimate.stats(data.extract=df_tCENEx,
level=alpha)
level=alpha,
dep.option='AR1')
# Get the associated time interval
I = interval(per[1], per[2])
......
......@@ -55,21 +55,22 @@ filedir =
# Name of the file that will be analysed from the BH directory
# (if 'all', all the file of the directory will be chosen)
filename =
# ""
""
# "all"
c(
# c(
# "S2235610_HYDRO_QJM.txt",
# "P1712910_HYDRO_QJM.txt",
# "P0885010_HYDRO_QJM.txt",
# "O5055010_HYDRO_QJM.txt",
# "O0384010_HYDRO_QJM.txt",
# "S4214010_HYDRO_QJM.txt",
"Q7002910_HYDRO_QJM.txt"
# "Q0214010_HYDRO_QJM.txt"
# "Q7002910_HYDRO_QJM.txt",
# "Q0214010_HYDRO_QJM.txt",
# "O3035210_HYDRO_QJM.txt",
# "O0554010_HYDRO_QJM.txt",
# "O1584610_HYDRO_QJM.txt"
)
# "Q6332510_HYDRO_QJM.txt"
# "O8255010_HYDRO_QJM.txt"
# )
## AGENCE EAU ADOUR GARONNE SELECTION
......@@ -79,8 +80,8 @@ AEAGlistdir =
""
AEAGlistname =
""
# "Liste-station_RRSE.docx"
# ""
"Liste-station_RRSE.docx"
## NIVALE SELECTION
......@@ -118,7 +119,7 @@ sampleSpan = c('05-01', '11-30')
## MAP
# Is the hydrological network needs to be plot
is_river = FALSE
is_river = TRUE
############### END OF REGION TO MODIFY (without risk) ###############
......@@ -361,68 +362,69 @@ df_shapefile = ini_shapefile(resources_path,
### 5.1. Simple time panel to criticize station data _________________
# Plot time panel of debit by stations
datasheet_layout(toplot=c('datasheet'),
df_meta=df_meta,
df_data=list(df_data,
df_sqrt),
var=list('Q', 'sqrt(Q)'),
type=list('data', 'data'),
layout_matrix=matrix(c(1, 2), ncol=1),
info_header=df_data,
df_shapefile=df_shapefile,
figdir=figdir,
resources_path=resources_path,
logo_dir=logo_dir,
AEAGlogo_file=AEAGlogo_file,
INRAElogo_file=INRAElogo_file,
FRlogo_file=FRlogo_file)
### 5.2. Analysis layout _____________________________________________
# datasheet_layout(toplot=c(
# 'datasheet'
# # 'matrix',
# # 'map'
# ),
# datasheet_layout(toplot=c('datasheet'),
# df_meta=df_meta,
# df_data=list(
# res_QAtrend$data,
# res_QMNAtrend$data,
# res_VCN10trend$data,
# res_tDEBtrend$data,
# res_tCENtrend$data
# ),
# df_trend=list(
# res_QAtrend$trend,
# res_QMNAtrend$trend,
# res_VCN10trend$trend,
# res_tDEBtrend$trend,
# res_tCENtrend$trend
# ),
# var=var,
# type=type,
# glose=glose,
# layout_matrix=matrix(c(1, 2, 3, 4, 5), ncol=1),
# missRect=TRUE,
# trend_period=trend_period,
# mean_period=mean_period,
# df_data=list(df_data,
# df_sqrt),
# var=list('Q', 'sqrt(Q)'),
# type=list('data', 'data'),
# layout_matrix=matrix(c(1, 2), ncol=1),
# info_header=df_data,
# time_header=df_data,
# foot_note=TRUE,
# info_height=2.8,
# time_ratio=2,
# var_ratio=3,
# foot_height=1.25,
# df_shapefile=df_shapefile,
# figdir=figdir,
# filename_opt='',
# resources_path=resources_path,
# logo_dir=logo_dir,
# AEAGlogo_file=AEAGlogo_file,
# INRAElogo_file=INRAElogo_file,
# FRlogo_file=FRlogo_file)
### 5.2. Analysis layout _____________________________________________
datasheet_layout(toplot=c(
'datasheet',
'matrix',
'map'
),
df_meta=df_meta,
df_data=list(
res_QAtrend$data,
res_QMNAtrend$data,
res_VCN10trend$data,
res_tDEBtrend$data,
res_tCENtrend$data
),
df_trend=list(
res_QAtrend$trend,
res_QMNAtrend$trend,
res_VCN10trend$trend,
res_tDEBtrend$trend,
res_tCENtrend$trend
),
var=var,
type=type,
glose=glose,
layout_matrix=matrix(c(1, 2, 3, 4, 5), ncol=1),
missRect=TRUE,
trend_period=trend_period,
mean_period=mean_period,
colorForce=TRUE,
info_header=df_data,
time_header=df_data,
foot_note=TRUE,
info_height=2.8,
time_ratio=2,
var_ratio=3,
foot_height=1.25,
df_shapefile=df_shapefile,
figdir=figdir,
filename_opt='',
resources_path=resources_path,
logo_dir=logo_dir,
AEAGlogo_file=AEAGlogo_file,
INRAElogo_file=INRAElogo_file,
FRlogo_file=FRlogo_file)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment