From 17a5eeff1f2d7ad0eae303d04223cec00c1128d6 Mon Sep 17 00:00:00 2001
From: "louis.heraut" <louis.heraut@inrae.fr>
Date: Thu, 9 Dec 2021 20:34:14 +0100
Subject: [PATCH] Commentary and debuging of rectangle mean step
---
plotting/panel.R | 679 ++++++++++++++++++++++++++++-------------------
script.R | 47 +---
2 files changed, 415 insertions(+), 311 deletions(-)
diff --git a/plotting/panel.R b/plotting/panel.R
index 5102b56..61409fb 100644
--- a/plotting/panel.R
+++ b/plotting/panel.R
@@ -10,16 +10,57 @@ library(ggh4x)
library(RColorBrewer)
+# Personal theme
+theme_ash =
+ theme(
+ # White background
+ panel.background=element_rect(fill='white'),
+ # Font
+ text=element_text(family='sans'),
+ # Border of plot
+ panel.border = element_rect(color="grey85",
+ fill=NA,
+ size=0.7),
+ # Grid
+ panel.grid.major.x=element_blank(),
+ panel.grid.major.y=element_blank(),
+ # Ticks marker
+ axis.ticks.x=element_line(color='grey75', size=0.3),
+ axis.ticks.y=element_line(color='grey75', size=0.3),
+ # Ticks label
+ axis.text.x=element_text(color='grey40'),
+ axis.text.y=element_text(color='grey40'),
+ # Ticks length
+ axis.ticks.length=unit(1.5, 'mm'),
+ # Ticks minor
+ ggh4x.axis.ticks.length.minor=rel(0.5),
+ # Title
+ plot.title=element_text(size=9, vjust=-2,
+ hjust=-1E-3, color='grey20'),
+ # Axis title
+ axis.title.x=element_blank(),
+ axis.title.y=element_blank(),
+ # Axis line
+ axis.line.x=element_blank(),
+ axis.line.y=element_blank(),
+ )
+
+
time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missRect=FALSE, unit2day=365.25, trend_period=NULL, mean_period=NULL, axis_xlim=NULL, last=FALSE, first=FALSE, color=NULL) {
+ # If 'type' is square root apply it to data
if (type == 'sqrt(Q)') {
df_data_code$Qm3s = sqrt(df_data_code$Qm3s)
}
+ # Compute max of flow
maxQ = max(df_data_code$Qm3s, na.rm=TRUE)
+ # Get the magnitude of the max of flow
power = get_power(maxQ)
+ # Normalize the max flow by it's magnitude
maxQtmp = maxQ/10^power
+ # Compute the spacing between y ticks
if (maxQtmp >= 5) {
dbrk = 1.0
} else if (maxQtmp < 5 & maxQtmp >= 3) {
@@ -32,12 +73,15 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
dbrk = 0.1
}
+ # Get the spacing in the right magnitude
dbrk = dbrk * 10^power
+ # Fix the accuracy for label
accuracy = NULL
+ # Time span in the unit of time
dDate = as.numeric(df_data_code$Date[length(df_data_code$Date)] -
df_data_code$Date[1]) / unit2day
-
+ # Compute the spacing between x ticks
if (dDate >= 100) {
datebreak = 25
dateminbreak = 5
@@ -49,39 +93,10 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
dateminbreak = 1
}
- p = ggplot() +
+ # Open new plot
+ p = ggplot() + theme_ash
- # theme_bw() +
-
- theme(panel.background=element_rect(fill='white'),
- text=element_text(family='sans'),
-
- panel.border = element_rect(color="grey85",
- fill=NA,
- size=0.7),
-
- # panel.grid.major.y=element_line(color='grey85', size=0.15),
- panel.grid.major.y=element_blank(),
- panel.grid.major.x=element_blank(),
-
- axis.ticks.y=element_line(color='grey75', size=0.3),
- axis.ticks.x=element_line(color='grey75', size=0.3),
-
- axis.text.x=element_text(color='grey40'),
- axis.text.y=element_text(color='grey40'),
-
- ggh4x.axis.ticks.length.minor=rel(0.5),
- axis.ticks.length=unit(1.5, 'mm'),
-
- plot.title=element_text(size=9, vjust=-2,
- hjust=-1E-3, color='grey20'),
- axis.title.x=element_blank(),
- axis.title.y=element_blank(),
-
- axis.line.x=element_blank(),
- axis.line.y=element_blank(),
- )
-
+ # If it is the lats plot of the pages or not
if (last) {
if (first) {
p = p +
@@ -90,7 +105,8 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
p = p +
theme(plot.margin=margin(0, 5, 5, 5, unit="mm"))
}
-
+
+ # If it is the first plot of the pages or not
} else {
if (first) {
p = p +
@@ -101,7 +117,7 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
}
}
- ### Sub period background ###
+ ## Sub period background ##
if (!is.null(trend_period)) {
# trend_period = as.list(trend_period)
@@ -126,25 +142,66 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
# ymax= maxQ*1.1),
# linetype=0, fill='grey97')
+ # Convert trend period to list if it is not
trend_period = as.list(trend_period)
+ # Fix a disproportionate minimum for period
Imin = 10^99
+ # For all the sub period of analysis in 'trend_period'
for (per in trend_period) {
+ # Compute time interval of period
I = interval(per[1], per[2])
+ # If it is the smallest interval
if (I < Imin) {
+ # Store it
Imin = I
+ # Fix min period of analysis
trend_period_min = as.Date(per)
}
}
-
+ # Search for the index of the closest existing date
+ # to the start of the min period of analysis
idMinPer = which.min(abs(df_data_code$Date - trend_period_min[1]))
+ # Same for the end of the min period of analysis
idMaxPer = which.min(abs(df_data_code$Date - trend_period_min[2]))
+ # Get the start and end date associated
minPer = df_data_code$Date[idMinPer]
maxPer = df_data_code$Date[idMaxPer]
+ # If it is not a flow or sqrt of flow time serie
if (type != 'sqrt(Q)' & type != 'Q') {
- maxPer = maxPer + years(1)
+ # 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 (type != 'sqrt(Q)' & type != '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]
+ }
+ # Add one year the the temporary end of period
+ # if there is no 'axis_lim'
+ } else {
+ maxPer = maxPer + years(1)
+ }
}
+ # Draw rectangle to delimiting the sub period
p = p +
geom_rect(aes(xmin=minPer,
ymin=0,
@@ -153,65 +210,129 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
linetype=0, fill='grey97')
}
- ### Mean step ###
+ ## Mean step ##
+ # 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)
-
+
+ # Blank tibble to store variable in order to plot
+ # rectangle for mean period
plot_mean = tibble()
+ # Blank tibble to store variable in order to plot
+ # upper limit of rectangle for mean period
plot_line = tibble()
+ # For all mean period
for (j in 1:nPeriod_mean) {
+ # 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 for the sub period
xmin = min(df_data_code_per$Date)
+ # If the min over the sub period is greater
+ # than the min of the entier period and
+ # it is not the first sub period
if (xmin > min(df_data_code$Date) & j != 1) {
+ # Substract 6 months to be in the middle of
+ # the previous year
xmin = xmin - months(6)
}
-
+ # If it is not a flow or sqrt of flow time serie and
+ # it is the first period
+ if (type != 'sqrt(Q)' & type != 'Q' & j == 1) {
+ # If there is an x axis limit
+ if (!is.null(axis_xlim)) {
+ # If the min of the period is before the x axis min
+ if (xmin < axis_xlim[1]) {
+ # The min for the sub period is the x axis
+ xmin = axis_xlim[1]
+ }
+ }
+ }
+ # Max for the sub period
xmax = max(df_data_code_per$Date)
+ # If the max over the sub period is smaller
+ # than the max of the entier period and
+ # it is not the last sub period
if (xmax < max(df_data_code$Date) & j != nPeriod_mean) {
+ # Add 6 months to be in the middle of
+ # the following year
xmax = xmax + months(6)
}
-
+ # If it is not a flow or sqrt of flow time serie and
+ # it is the last period
if (type != 'sqrt(Q)' & type != 'Q' & j == nPeriod_mean) {
- xmax = xmax + years(1)
+ # If there is an x axis limit
+ if (!is.null(axis_xlim)) {
+ # If the max of the period plus 1 year
+ # is smaller thant the max of the x axis limit
+ if (xmax + years(1) < axis_xlim[2]) {
+ # Add one year to the max to include
+ # the entire last year graphically
+ xmax = xmax + years(1)
+ } else {
+ # The max of this sub period is the max
+ # of the x axis limit
+ xmax = axis_xlim[2]
+ }
+ # If there is no axis limit
+ } else {
+ # Add one year to the max to include
+ # the entire last year graphically
+ xmax = xmax + years(1)
+ }
}
-
+ # Mean of the flow over the sub period
ymax = mean(df_data_code_per$Qm3s, na.rm=TRUE)
+ # Create temporary tibble with variable
+ # to create rectangle for mean step
plot_meantmp = tibble(xmin=xmin, xmax=xmax,
ymin=0, ymax=ymax, period=j)
+ # Bind it to the main tibble to store it with other period
plot_mean = bind_rows(plot_mean, plot_meantmp)
+ # Create vector for the upper limit of the rectangle
abs = c(xmin, xmax)
ord = c(ymax, ymax)
+ # Create temporary tibble with variable
+ # to create upper limit for rectangle
plot_linetmp = tibble(abs=abs, ord=ord, period=j)
+ # Bind it to the main tibble to store it with other period
plot_line = bind_rows(plot_line, plot_linetmp)
}
-
+ # Plot rectangles
p = p +
geom_rect(data=plot_mean,
aes(xmin=xmin, ymin=ymin,
xmax=xmax, ymax=ymax),
- linetype=0, fill='grey93')
+ linetype=0, fill='grey93')
+ # Plot upper line for rectangle
p = p +
geom_line(data=plot_line,
aes(x=abs, y=ord, group=period),
color='grey85',
size=0.15)
- # plot_grid = tibble(abs=as.Date(abs), ord=ord)
-
+ # For all the sub periods except the last one
for (i in 1:(nPeriod_mean-1)) {
+ # The y limit of rectangle is the max of
+ # the two neighboring mean step rectangle
yLim = max(c(plot_mean$ymax[i], plot_mean$ymax[i+1]))
+ # The x limit is the x max of the ith rectangle
xLim = plot_mean$xmax[i]
+ # Make a tibble to store data
plot_lim = tibble(x=c(xLim, xLim), y=c(0, yLim))
+ # Plot the limit of rectangles
p = p +
geom_line(data=plot_lim, aes(x=x, y=y),
linetype='dashed', size=0.15, color='grey85')
@@ -220,44 +341,68 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
}
### Grid ###
+ # If there is no axis limit
if (is.null(axis_xlim)) {
+ # The min and the max is set by
+ # the min and the max of the date data
xmin = min(df_data_code$Date)
xmax = max(df_data_code$Date)
} else {
+ # Min and max is set with the limit axis parameter
xmin = axis_xlim[1]
xmax = axis_xlim[2]
}
+ # Create a vector for all the y grid position
ygrid = seq(0, maxQ*10, dbrk)
+ # Blank vector to store position
ord = c()
abs = c()
+ # For all the grid element
for (i in 1:length(ygrid)) {
+ # Store grid position
ord = c(ord, rep(ygrid[i], times=2))
abs = c(abs, xmin, xmax)
}
+ # Create a tibble to store all the position
plot_grid = tibble(abs=as.Date(abs), ord=ord)
+ # Plot the y grid
p = p +
geom_line(data=plot_grid,
aes(x=abs, y=ord, group=ord),
color='grey85',
size=0.15)
+ ### Data ###
+ # If it is a square root flow or flow
if (type == 'sqrt(Q)' | type == 'Q') {
+ # Plot the data as line
p = p +
geom_line(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
color='grey20',
- size=0.3)
+ size=0.3,
+ lineend="round")
} else {
+ # Plot the data as point
p = p +
geom_point(aes(x=df_data_code$Date, y=df_data_code$Qm3s),
shape=21, color='grey50', fill='grey95', size=1)
}
+ ### Missing data ###
+ # If the option is TRUE
if (missRect) {
+ # Remove NA data
NAdate = df_data_code$Date[is.na(df_data_code$Qm3s)]
+ # Get the difference between each point of date data without NA
dNAdate = diff(NAdate)
+ # If difference of day is not 1 then
+ # it is TRUE for the beginning of each missing data period
NAdate_Down = NAdate[append(Inf, dNAdate) != 1]
+ # If difference of day is not 1 then
+ # it is TRUE for the ending of each missing data period
NAdate_Up = NAdate[append(dNAdate, Inf) != 1]
+ # Plot the missing data period
p = p +
geom_rect(aes(xmin=NAdate_Down,
ymin=0,
@@ -265,69 +410,122 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
ymax=maxQ*1.1),
linetype=0, fill='Wheat', alpha=0.4)
}
-
+
+ ### Trend ###
+ # If there is trends
if (!is.null(df_trend_code)) {
-
+
+ # Extract starting period of trends
Start = df_trend_code$period_start
+ # Get the name of the different period
UStart = levels(factor(Start))
+ # Same for ending
End = df_trend_code$period_end
UEnd = levels(factor(End))
-
+
+ # Compute the max of different start and end
+ # so the number of different period
nPeriod_trend = max(length(UStart), length(UEnd))
-
+
+ # Blank tibble to store trend data and legend data
plot_trend = tibble()
leg_trend = tibble()
+ # For all the different period
for (i in 1:nPeriod_trend) {
+ # Get the trend associated to the first period
df_trend_code_per =
df_trend_code[df_trend_code$period_start == Start[i]
& df_trend_code$period_end == End[i],]
-
+
+ # Number of trend selected
+ Ntrend = nrow(df_trend_code_per)
+ # If the number of trend is greater than a unique one
+ if (Ntrend > 1) {
+ # Extract only the first hence it is the same period
+ df_trend_code_per = df_trend_code_per[1,]
+ }
+
+ # Search for the index of the closest existing date
+ # to the start of the trend period of analysis
iStart = which.min(abs(df_data_code$Date - Start[i]))
+ # Same for the end
iEnd = which.min(abs(df_data_code$Date - End[i]))
-
+
+ # Get the start and end date associated
xmin = df_data_code$Date[iStart]
xmax = df_data_code$Date[iEnd]
+
+ # If there is a x axis limit
if (!is.null(axis_xlim)) {
+ # If the min of the current period
+ # is smaller than the min of the x axis limit
if (xmin < axis_xlim[1]) {
+ # The min of the period is the min
+ # of the x axis limit
xmin = axis_xlim[1]
- }
+ }
+ # Same for end
if (xmax > axis_xlim[2]) {
xmax = axis_xlim[2]
}
}
-
- abs = c(xmin, xmax)
+
+ # Create vector to store x data
+ abs = c(xmin, xmax)
+ # Convert the number of day to the unit of the period
abs_num = as.numeric(abs) / unit2day
+ # Compute the y of the trend
ord = abs_num * df_trend_code_per$trend +
df_trend_code_per$intercept
-
+
+ # Create temporary tibble with variable to plot trend
+ # for each period
plot_trendtmp = tibble(abs=abs, ord=ord, period=i)
+ # Bind it to the main tibble to store it with other period
plot_trend = bind_rows(plot_trend, plot_trendtmp)
- codeDate = df_data_code$Date
+ # If there is a x axis limit
+ if (!is.null(axis_xlim)) {
+ # The x axis limit is selected
+ codeDate = axis_xlim
+ } else {
+ # The entire date data is selected
+ codeDate = df_data_code$Date
+ }
+ # The flow data is extract
codeQ = df_data_code$Qm3s
-
+
+ # Position of the x beginning and end of the legend symbol
x = gpct(2, codeDate, shift=TRUE)
xend = x + gpct(3, codeDate)
-
+
+ # Position of the y beginning and end of the legend symbol
dy = gpct(7, codeQ, ref=0)
y = gpct(100, codeQ, ref=0) - (i-1)*dy
yend = y
-
+
+ # Position of x for the beginning of the associated text
xt = xend + gpct(1, codeDate)
+ # Position of the background rectangle of the legend
xminR = x - gpct(1, codeDate)
yminR = y - gpct(4, codeQ, ref=0)
xmaxR = x + gpct(24, codeDate)
ymaxR = y + gpct(5, codeQ, ref=0)
+ # Get the tendance analyse
trend = df_trend_code_per$trend
- power = power = get_power(trend)
+ # Compute the magnitude of the trend
+ power = get_power(trend)
+ # Convert it to character
powerC = as.character(power)
- brk = 10^power
+ # Get the power of ten of magnitude
+ brk = 10^power
+ # Convert trend to character for sientific expression
trendC = as.character(round(trend / brk, 2))
+ # Create temporary tibble with variable to plot legend
leg_trendtmp = tibble(x=x, xend=xend,
y=y, yend=yend,
xt=xt,
@@ -336,14 +534,16 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
xminR=xminR, yminR=yminR,
xmaxR=xmaxR, ymaxR=ymaxR,
period=i)
-
- leg_trend = bind_rows(leg_trend, leg_trendtmp)
-
+ # Bind it to the main tibble to store it with other period
+ leg_trend = bind_rows(leg_trend, leg_trendtmp)
}
+ # 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,]
+ # Plot the background for legend
p = p +
geom_rect(data=leg_trend_per,
aes(xmin=xminR,
@@ -352,17 +552,21 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
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
trendC = leg_trend_per$trendC
powerC = leg_trend_per$powerC
-
+
+ # Create the name of the trend
label = bquote(bold(.(trendC)~'x'~'10'^{.(powerC)})~'['*m^{3}*'.'*s^{-1}*'.'*an^{-1}*']')
+ # Plot the trend symbole and value of the legend
p = p +
-
annotate("segment",
x=leg_trend_per$x, xend=leg_trend_per$xend,
y=leg_trend_per$y, yend=leg_trend_per$yend,
@@ -377,45 +581,58 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
color=color[i])
}
+ # For all periods
for (i in 1:nPeriod_trend) {
+ # Extract the trend of the current sub period
plot_trend_per = plot_trend[plot_trend$period == i,]
+
+ # Plot the line of white background of each trend
p = p +
geom_line(data=plot_trend_per,
aes(x=abs, y=ord),
color='white',
linetype='solid',
- size=1)
+ size=1,
+ lineend="round")
}
+ # For all periods
for (i in 1:nPeriod_trend) {
+ # Extract the trend of the current sub period
plot_trend_per = plot_trend[plot_trend$period == i,]
+
+ # Plot the line of trend
p = p +
geom_line(data=plot_trend_per,
aes(x=abs, y=ord),
color=color[i],
linetype='solid',
- size=0.5)
+ size=0.5,
+ lineend="round")
}
-
-
-
}
+ # Title
p = p +
ggtitle(bquote(bold(.(type))~~'['*m^{3}*'.'*s^{-1}*']'))
+ # If the is no x axis limit
if (is.null(axis_xlim)) {
+ # Parameters of the x axis contain the limit of the date data
p = p +
- scale_x_date(date_breaks=paste(as.character(datebreak),
- 'year', sep=' '),
- date_minor_breaks=paste(as.character(dateminbreak),
- 'year', sep=' '),
+ scale_x_date(date_breaks=paste(
+ as.character(datebreak),
+ 'year', sep=' '),
+ date_minor_breaks=paste(
+ as.character(dateminbreak),
+ 'year', sep=' '),
guide='axis_minor',
date_labels="%Y",
limits=c(min(df_data_code$Date),
max(df_data_code$Date)),
expand=c(0, 0))
} else {
+ # Parameters of the x axis contain the x axis limit
p = p +
scale_x_date(date_breaks=paste(
as.character(datebreak),
@@ -428,7 +645,8 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
limits=axis_xlim,
expand=c(0, 0))
}
-
+
+ # Parameters of the y axis
p = p +
scale_y_continuous(breaks=seq(0, maxQ*10, dbrk),
limits=c(0, maxQ*1.1),
@@ -439,101 +657,6 @@ time_panel = function (df_data_code, df_trend_code, type, p_threshold=0.1, missR
}
-text_panel = function(code, df_meta) {
- df_meta_code = df_meta[df_meta$code == code,]
-
- text1 = paste(
- "<b>", code, '</b> - ', df_meta_code$nom, ' (',
- df_meta_code$region_hydro, ')',
- sep='')
-
- text2 = paste(
- "<b>",
- "Gestionnaire : ", df_meta_code$gestionnaire, "<br>",
- "</b>",
- sep='')
-
- text3 = paste(
- "<b>",
- "Superficie : ", df_meta_code$surface_km2_BH, " [km<sup>2</sup>] <br>",
- "X = ", df_meta_code$L93X_m_BH, " [m ; Lambert 93]",
- "</b>",
- sep='')
-
- text4 = paste(
- "<b>",
- "Altitude : ", df_meta_code$altitude_m_BH, " [m]<br>",
- "Y = ", df_meta_code$L93Y_m_BH, " [m ; Lambert 93]",
- "</b>",
- sep='')
-
- # text3 = paste(
- # "<b>",
- # "Superficie : ", df_meta_code$surface_km2_IN,
- # ' (', df_meta_code$surface_km2_BH, ')', " [km<sup>2</sup>] <br>",
- # "X = ", df_meta_code$L93X_m_IN,
- # ' (', df_meta_code$L93X_m_BH, ')', " [m ; Lambert 93]",
- # "</b>",
- # sep='')
-
- # text4 = paste(
- # "<b>",
- # "Altitude : ", df_meta_code$altitude_m_IN,
- # ' (', df_meta_code$altitude_m_BH, ')', " [m]<br>",
- # "Y = ", df_meta_code$L93Y_m_IN,
- # ' (', df_meta_code$L93Y_m_BH, ')', " [m ; Lambert 93]",
- # "</b>",
- # sep='')
-
- # text5 = paste(
- # "<b>",
- # "INRAE (Banque Hydro)<br>",
- # "INRAE (Banque Hydro)",
- # "</b>",
- # sep='')
-
- gtext1 = richtext_grob(text1,
- x=0, y=1,
- margin=unit(c(t=5, r=5, b=0, l=5), "mm"),
- hjust=0, vjust=1,
- gp=gpar(col="#00A3A8", fontsize=14))
-
- gtext2 = richtext_grob(text2,
- x=0, y=0.55,
- margin=unit(c(t=0, r=5, b=0, l=5), "mm"),
- hjust=0, vjust=1,
- gp=gpar(col="grey20", fontsize=8))
-
- gtext3 = richtext_grob(text3,
- x=0, y=1,
- margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
- hjust=0, vjust=1,
- gp=gpar(col="grey20", fontsize=9))
-
- gtext4 = richtext_grob(text4,
- x=0, y=1,
- margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
- hjust=0, vjust=1,
- gp=gpar(col="grey20", fontsize=9))
-
- # gtext5 = richtext_grob(text5,
- # x=0, y=1,
- # margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
- # hjust=0, vjust=1,
- # gp=gpar(col="grey20", fontsize=9))
-
- gtext_merge = grid.arrange(grobs=list(gtext1, gtext2, gtext3,
- gtext4),#, gtext5),
- layout_matrix=matrix(c(1, 1, 1,
- 2, 2, 2,
- 3, 4, 5),
- nrow=3,
- byrow=TRUE))
- return(gtext_merge)
-}
-
-
-
matrice_panel = function (list_df2plot, df_meta, trend_period) {
nbp = length(list_df2plot)
@@ -546,7 +669,7 @@ matrice_panel = function (list_df2plot, df_meta, trend_period) {
nPeriod_max = 0
for (code in Code) {
-
+
df_trend_code = df_trend[df_trend$code == code,]
Start = df_trend_code$period_start
@@ -720,37 +843,17 @@ matrice_panel = function (list_df2plot, df_meta, trend_period) {
options(repr.plot.width=width, repr.plot.height=height)
- mat = ggplot() +
-
- theme(
- panel.background=element_rect(fill='white'),
- text=element_text(family='sans'),
- panel.border=element_blank(),
-
- panel.grid.major.y=element_blank(),
- panel.grid.major.x=element_blank(),
-
- axis.text.x=element_blank(),
- axis.text.y=element_blank(),
-
- axis.ticks.y=element_blank(),
- axis.ticks.x=element_blank(),
-
- ggh4x.axis.ticks.length.minor=rel(0.5),
- axis.ticks.length=unit(1.5, 'mm'),
-
- plot.title=element_text(size=9, vjust=-3,
- hjust=-1E-3, color='grey20'),
-
- axis.title.x=element_blank(),
- axis.title.y=element_blank(),
-
- axis.line.x=element_blank(),
- axis.line.y=element_blank(),
-
- plot.margin=margin(5, 5, 5, 5, unit="mm"),
- )
+ mat = ggplot() + theme_ash +
+ 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(),
+ )
+
# xt = -1
# yt = height + 1.75
# Title = bquote(bold(Territoire))
@@ -771,9 +874,6 @@ matrice_panel = function (list_df2plot, df_meta, trend_period) {
Fill_mat_per = Fill_mat[NPeriod_mat == j]
Color_mat_per = Color_mat[NPeriod_mat == j]
- # print(j)
- # print(Fill_mat_per)
-
Xtmp = as.integer(factor(as.character(Type_mat_per)))
Xc = j + (j - 1)*nbp*2
@@ -876,9 +976,6 @@ matrice_panel = function (list_df2plot, df_meta, trend_period) {
if (nchar(name) > ncharMax) {
name = paste(substr(name, 1, ncharMax), '...', sep='')
}
- # label = bquote(.(name)~'-'~bold(.(code)))
- # period_code = Periods_code[[i]]
- # nPeriod_code = length(period_code)
mat = mat +
annotate('text', x=0.3, y=i + 0.14,
@@ -928,8 +1025,101 @@ matrice_panel = function (list_df2plot, df_meta, trend_period) {
}
+text_panel = function(code, df_meta) {
+ df_meta_code = df_meta[df_meta$code == code,]
-histogram = function (data_bin, df_meta, breaks=NULL, bins=NULL, binwidth=NULL, figdir='', filedir_opt='') {
+ text1 = paste(
+ "<b>", code, '</b> - ', df_meta_code$nom, ' (',
+ df_meta_code$region_hydro, ')',
+ sep='')
+
+ text2 = paste(
+ "<b>",
+ "Gestionnaire : ", df_meta_code$gestionnaire, "<br>",
+ "</b>",
+ sep='')
+
+ text3 = paste(
+ "<b>",
+ "Superficie : ", df_meta_code$surface_km2_BH, " [km<sup>2</sup>] <br>",
+ "X = ", df_meta_code$L93X_m_BH, " [m ; Lambert 93]",
+ "</b>",
+ sep='')
+
+ text4 = paste(
+ "<b>",
+ "Altitude : ", df_meta_code$altitude_m_BH, " [m]<br>",
+ "Y = ", df_meta_code$L93Y_m_BH, " [m ; Lambert 93]",
+ "</b>",
+ sep='')
+
+ # text3 = paste(
+ # "<b>",
+ # "Superficie : ", df_meta_code$surface_km2_IN,
+ # ' (', df_meta_code$surface_km2_BH, ')', " [km<sup>2</sup>] <br>",
+ # "X = ", df_meta_code$L93X_m_IN,
+ # ' (', df_meta_code$L93X_m_BH, ')', " [m ; Lambert 93]",
+ # "</b>",
+ # sep='')
+
+ # text4 = paste(
+ # "<b>",
+ # "Altitude : ", df_meta_code$altitude_m_IN,
+ # ' (', df_meta_code$altitude_m_BH, ')', " [m]<br>",
+ # "Y = ", df_meta_code$L93Y_m_IN,
+ # ' (', df_meta_code$L93Y_m_BH, ')', " [m ; Lambert 93]",
+ # "</b>",
+ # sep='')
+
+ # text5 = paste(
+ # "<b>",
+ # "INRAE (Banque Hydro)<br>",
+ # "INRAE (Banque Hydro)",
+ # "</b>",
+ # sep='')
+
+ gtext1 = richtext_grob(text1,
+ x=0, y=1,
+ margin=unit(c(t=5, r=5, b=0, l=5), "mm"),
+ hjust=0, vjust=1,
+ gp=gpar(col="#00A3A8", fontsize=14))
+
+ gtext2 = richtext_grob(text2,
+ x=0, y=0.55,
+ margin=unit(c(t=0, r=5, b=0, l=5), "mm"),
+ hjust=0, vjust=1,
+ gp=gpar(col="grey20", fontsize=8))
+
+ gtext3 = richtext_grob(text3,
+ x=0, y=1,
+ margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
+ hjust=0, vjust=1,
+ gp=gpar(col="grey20", fontsize=9))
+
+ gtext4 = richtext_grob(text4,
+ x=0, y=1,
+ margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
+ hjust=0, vjust=1,
+ gp=gpar(col="grey20", fontsize=9))
+
+ # gtext5 = richtext_grob(text5,
+ # x=0, y=1,
+ # margin=unit(c(t=0, r=5, b=5, l=5), "mm"),
+ # hjust=0, vjust=1,
+ # gp=gpar(col="grey20", fontsize=9))
+
+ gtext_merge = grid.arrange(grobs=list(gtext1, gtext2, gtext3,
+ gtext4),#, gtext5),
+ layout_matrix=matrix(c(1, 1, 1,
+ 2, 2, 2,
+ 3, 4, 5),
+ nrow=3,
+ byrow=TRUE))
+ return(gtext_merge)
+}
+
+
+histogram = function (data_bin, df_meta, figdir='', filedir_opt='') {
# Get all different stations code
Code = levels(factor(df_meta$code))
@@ -950,38 +1140,13 @@ histogram = function (data_bin, df_meta, breaks=NULL, bins=NULL, binwidth=NULL,
breaks = as.Date(res_hist$breaks)
mids = as.Date(res_hist$mids)
- p = ggplot() +
+ p = ggplot() + theme_ash +
- theme(panel.background=element_rect(fill='white'),
- text=element_text(family='sans'),
-
- panel.border = element_rect(color="grey85",
- fill=NA,
- size=0.7),
-
- panel.grid.major.y=element_line(color='grey85', size=0.15),
- panel.grid.major.x=element_blank(),
-
- axis.ticks.y=element_line(color='grey75', size=0.3),
- axis.ticks.x=element_line(color='grey75', size=0.3),
-
- axis.text.x=element_text(color='grey40'),
- axis.text.y=element_text(color='grey40'),
-
- ggh4x.axis.ticks.length.minor=rel(0.5),
- axis.ticks.length=unit(1.5, 'mm'),
-
- plot.title=element_text(size=9, vjust=-2,
- hjust=-1E-3, color='grey20'),
- axis.title.x=element_blank(),
- axis.title.y=element_blank(),
- axis.line.x=element_blank(),
- axis.line.y=element_blank(),
- ) +
+ theme(panel.grid.major.y=element_line(color='grey85', size=0.15),
+ axis.title.y=element_blank()) +
geom_bar(aes(x=mids, y=counts_pct),
stat='identity',
- # color="#00A3A8",
fill="#00A3A8") +
scale_x_date(date_breaks=paste(as.character(datebreak),
@@ -1005,7 +1170,7 @@ histogram = function (data_bin, df_meta, breaks=NULL, bins=NULL, binwidth=NULL,
}
-cumulative = function (data_bin, df_meta, dyear=10, breaks=NULL, bins=NULL, binwidth=NULL, figdir='', filedir_opt='') {
+cumulative = function (data_bin, df_meta, dyear=10, figdir='', filedir_opt='') {
# Get all different stations code
Code = levels(factor(df_meta$code))
@@ -1047,34 +1212,10 @@ cumulative = function (data_bin, df_meta, dyear=10, breaks=NULL, bins=NULL, binw
print(paste('mediane :', q50))
- p = ggplot() +
-
- theme(panel.background=element_rect(fill='white'),
- text=element_text(family='sans'),
-
- panel.border = element_rect(color="grey85",
- fill=NA,
- size=0.7),
+ p = ggplot() + theme_ash +
- panel.grid.major.y=element_line(color='grey85', size=0.15),
- panel.grid.major.x=element_blank(),
-
- axis.ticks.y=element_line(color='grey75', size=0.3),
- axis.ticks.x=element_line(color='grey75', size=0.3),
-
- axis.text.x=element_text(color='grey40'),
- axis.text.y=element_text(color='grey40'),
-
- ggh4x.axis.ticks.length.minor=rel(0.5),
- axis.ticks.length=unit(1.5, 'mm'),
-
- plot.title=element_text(size=9, vjust=-2,
- hjust=-1E-3, color='grey20'),
- axis.title.x=element_blank(),
- axis.title.y=element_blank(),
- axis.line.x=element_blank(),
- axis.line.y=element_blank(),
- ) +
+ theme(panel.grid.major.y=element_line(color='grey85', size=0.15),
+ axis.title.y=element_blank()) +
geom_line(aes(x=mids, y=cumul_pct),
color="#00A3A8") +
diff --git a/script.R b/script.R
index a8c4948..7a85d8c 100644
--- a/script.R
+++ b/script.R
@@ -1,5 +1,4 @@
-
-###### A MODIFIER ######
+############ A MODIFIER ############
# Path to the data
@@ -33,9 +32,9 @@ filename =
# "A2250310_HYDRO_QJM.txt"
# )
- c("O3035210_HYDRO_QJM.txt",
- "O3011010_HYDRO_QJM.txt",
- "O1442910_HYDRO_QJM.txt")
+ c("S4214010_HYDRO_QJM.txt",
+ "Q6332510_HYDRO_QJM.txt",
+ "Q7002910_HYDRO_QJM.txt")
@@ -74,7 +73,7 @@ mean_period = list(period1, period2)
p_thresold = 0.1 #c(0.01, 0.05, 0.1)
-########################
+####################################
# FILE STRUCTURE #
@@ -206,13 +205,9 @@ res_VCN10trend = get_VCN10trend(df_data, df_meta,
# df_break = get_break(res_VCN10trend$data, df_meta)
# histogram(df_break$Date, df_meta,
- # breaks=seq(min(df_break$Date),
- # max(df_break$Date), "years"),
# figdir=figdir)
# cumulative(df_break$Date, df_meta, dyear=8,
- # breaks=seq(min(df_break$Date),
- # max(df_break$Date), "years"),
# figdir=figdir)
# TIME PANEL #
@@ -245,38 +240,6 @@ panels_layout(list(res_QAtrend$data, res_QMNAtrend$data,
figdir=figdir,
filename_opt='')
-# panels_layout(list(res_QAtrend$data, res_VCN10trend$data),
-# layout_matrix=c(1, 2),
-# df_meta=df_meta,
-# df_trend=list(res_QAtrend$trend,
-# res_VCN10trend$trend),
-# type=list(bquote(Q[A]), bquote(V[CN10])),
-# missRect=list(TRUE, TRUE),
-# period=trend_period,
-# info_header=TRUE,
-# time_header=df_data,
-# time_ratio=2,
-# var_ratio=5,
-# figdir=figdir,
-# filename_opt='')
-
-
-
-# panels_layout(list(res_QMNAtrend$data),
-# layout_matrix=c(1),
-# df_meta=df_meta,
-# df_trend=list(res_QMNAtrend$trend),
-# type=list(bquote(Q[MNA])),
-# missRect=list(TRUE),
-# period=trend_period,
-# info_header=TRUE,
-# time_header=df_data,
-# time_ratio=2,
- # var_ratio=5,
- # figdir=figdir,
-# filename_opt='')
-
-
### /!\ Removed 185 row(s) containing missing values (geom_path) -> remove NA ###
--
GitLab