## ----warning=FALSE, include=FALSE---------------------------------------------
R_bib <- toBibtex(citation())
R_bib <- gsub("@Manual\\{", "@Manual{Rsoftware_man", R_bib)
airGR_bib <- toBibtex(citation("airGR"))
airGR_bib <- gsub("@Article\\{", "@Article{airGR_art", airGR_bib)
airGR_bib <- gsub("@Manual\\{", "@Manual{airGR_man", airGR_bib)
airGRteaching_bib <- toBibtex(citation("airGRteaching"))
airGRteaching_bib <- gsub("@Manual\\{", "@Manual{airGRteaching_man", airGRteaching_bib)
airGRteaching_bib <- gsub("@Article\\{", "@Article{airGRteaching_art", airGRteaching_bib)
airGRdatasets_bib <- toBibtex(citation("airGRdatasets"))
airGRdatasets_bib <- gsub("@Manual\\{", "@Manual{airGRdatasets_man", airGRdatasets_bib)
options(encoding = "UTF-8")
writeLines(text = c(R_bib, airGR_bib, airGRteaching_bib, airGRdatasets_bib), con = "airGR_galaxy.bib")
options(encoding = "native.enc")
## ----include=FALSE------------------------------------------------------------
formatGR <- '%s'
GR <- sprintf(formatGR, "GR")
airGR <- sprintf(formatGR, "airGR")
airGRteaching <- sprintf(formatGR, "airGRteaching")
airGRdatasets <- sprintf(formatGR, "airGRdatasets")
## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE, fig.path = "figure/")
library(airGRteaching)
Sys.setlocale("LC_TIME", "English")
colorize <- function(x, color) {
if (knitr::is_latex_output()) {
sprintf("\\textcolor{%s}{%s}", color, x)
} else if (knitr::is_html_output()) {
sprintf("%s", color, x)
} else {
x
}
}
## ----echo=TRUE, eval=TRUE-----------------------------------------------------
# Package loading
library(airGRdatasets)
# Catchment data loading
data("B222001001", package = "airGRdatasets")
# Structure of the catchment data object
str(B222001001)
## ----echo=TRUE, eval=TRUE-----------------------------------------------------
# Package loading
library(airGRdatasets)
# Catchment data loading
data("B222001001", package = "airGRdatasets")
# Observed daily time series
ts_obs <- B222001001$TS
# Data processing for GR4J (without Q)
prep_no_q <- PrepGR(DatesR = ts_obs$Date,
Precip = ts_obs$Ptot,
PotEvap = ts_obs$Evap,
HydroModel = "GR4J",
CemaNeige = FALSE)
# Simulation period
per_sim <- range(prep_no_q$InputsModel$DatesR)
## ----v00_fig_gr4j_x2, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Different X2 values around its median values (0 [mm/d])
param_x2 <- seq(from = -2, to = 2, by = 1)
# Combination of parameter values (X1, X3 and X4 are fixed; X2 changes)
param_gr4j <- expand.grid(X1 = 350,
X2 = param_x2,
X3 = 90,
X4 = 1.4)
# Streamflow simulations using parameter sets
sim_x2 <- apply(param_gr4j, MARGIN = 1, FUN = function(i_param_gr4j) {
i_sim <- SimGR(PrepGR = prep_no_q,
Param = i_param_gr4j,
SimPer = per_sim,
verbose = FALSE)
i_sim$OutputsModel$Qsim
})
# Graphical comparison
ind_zoom <- 400:430
col_param_x2 <- colorRampPalette(c("green1", "green4"))(ncol(sim_x2))
matplot(x = as.POSIXct(prep_no_q$InputsModel$DatesR[ind_zoom]),
y = sim_x2[ind_zoom, ],
xlab = "time [d]", ylab = "flow [mm/d]",
type = "l", lty = 1, lwd = 2, col = col_param_x2)
legend("topright",
legend = sprintf("% .1f", param_x2),
lwd = 2, col = col_param_x2,
title = "X2 values [mm/d]",
bg = "white")
## ----v00_fig_gr4j_x4, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Different X4 values around its median values (1.4 [d])
param_x4 <- seq(from = 1.0, to = 3.0, by = 0.5)
# Combination of parameter values (X1, X2 and X3 are fixed; X4 changes)
param_gr4j <- expand.grid(X1 = 350,
X2 = 0,
X3 = 90,
X4 = param_x4)
# Streamflow simulations using parameter sets
sim_x4 <- apply(param_gr4j, MARGIN = 1, FUN = function(i_param_gr4j) {
i_sim <- SimGR(PrepGR = prep_no_q,
Param = i_param_gr4j,
SimPer = per_sim,
verbose = FALSE)
i_sim$OutputsModel$Qsim
})
# Graphical comparison
ind_zoom <- 400:430
col_param_x4 <- colorRampPalette(c("steelblue1", "steelblue4"))(ncol(sim_x4))
matplot(x = as.POSIXct(prep_no_q$InputsModel$DatesR[ind_zoom]),
y = sim_x4[ind_zoom, ],
xlab = "time [d]", ylab = "flow [mm/d]",
type = "l", lty = 1, lwd = 2, col = col_param_x4)
legend("topright",
legend = sprintf("% .1f", param_x4),
lwd = 2,col = col_param_x4,
title = "X4 values [d]",
bg = "white")
## ----v00_fig_sim_aggreg, echo=TRUE, eval=TRUE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Aggregation of the simulated streamflow at the yearly time step
sim_x2_y <- cbind(DatesR = as.POSIXct(prep_no_q$InputsModel$DatesR),
as.data.frame(sim_x2))
sim_x2_y <- SeriesAggreg(x = sim_x2_y,
Format = "%Y",
ConvertFun = rep("sum", ncol(sim_x2_y) - 1))
sim_x4_y <- cbind(DatesR = as.POSIXct(prep_no_q$InputsModel$DatesR),
as.data.frame(sim_x4))
sim_x4_y <- SeriesAggreg(x = sim_x4_y,
Format = "%Y",
ConvertFun = rep("sum", ncol(sim_x4_y) - 1))
# Graphical comparison
matplot(x = sim_x2_y$DatesR, y = sim_x2_y[, -1],
type = "l", lty = 1, lwd = 2, col = col_param_x2,
xlab = "time [yr]", ylab = "flow [mm/yr]")
matlines(x = sim_x4_y$DatesR, y = sim_x4_y[, -1],
type = "l", lty = 1, lwd = 2, col = col_param_x4)
legend("topright",
legend = c("X2", "X4"),
lwd = 2, col = c(median(col_param_x2), median(col_param_x4)),
bg = "white")
## ----v00_fig_wup, echo=TRUE, eval=TRUE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Warm-up and simulation periods
per_wup1m <- c("2002-12-01", "2002-12-31")
per_wup1y <- c("2002-01-01", "2002-12-31")
per_sim <- c("2003-01-01", "2006-12-31")
# Parameter set
param_gr4j <- c(X1 = 350, X32 = 0, X3 = 90, X4 = 1.4)
# Simulation without warm-up period
sim_wup0d <- SimGR(PrepGR = prep_no_q,
Param = param_gr4j,
WupPer = 0L,
SimPer = per_sim)
# Simulation with a 1-month warm-up period
sim_wup1m <- SimGR(PrepGR = prep_no_q,
Param = param_gr4j,
WupPer = per_wup1m,
SimPer = per_sim)
# Simulation with a 4-year warm-up period
sim_wup1y <- SimGR(PrepGR = prep_no_q,
Param = param_gr4j,
WupPer = per_wup1y,
SimPer = per_sim)
# Graphical comparison
col_wup <- c("orchid", "orange2", "green3")
matplot(x = as.POSIXct(sim_wup0d$OutputsModel$DatesR),
y = cbind(sim_wup0d$OutputsModel$Qsim,
sim_wup1m$OutputsModel$Qsim,
sim_wup1y$OutputsModel$Qsim),
xlab = "time [d]", ylab = "flow [mm/d]",
type = "l", lty = 1, lwd = 2, col = col_wup,
xlim = as.POSIXct(x = c("2003-01-01", "2003-09-01"), tz = "UTC"))
legend("topright",
legend = c("no warm-up", "1-month warm-up", "1-year warm-up"),
col = col_wup, lwd = 2,
bg = "white")
## ----v00_fig_cal_manu, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=7*1.5, fig.height=5*1.5, out.width='98%'----
# Data processing for GR4J (with Q for calibration)
prep <- PrepGR(DatesR = ts_obs$Date,
Precip = ts_obs$Ptot,
PotEvap = ts_obs$Evap,
Qobs = ts_obs$Qmmd,
HydroModel = "GR4J",
CemaNeige = FALSE)
# Parameter set to test
i_param_gr4j <- c(X1 = 350, X2 = 0, X3 = 90, X4 = 1.4)
# Rainfall-runoff simulation on the calibration period
i_sim_manu <- SimGR(PrepGR = prep,
Param = param_gr4j,
WupPer = c("1999-01-01", "2000-12-31"),
SimPer = c("2001-01-01", "2010-12-31"),
EffCrit = "NSE",
verbose = TRUE)
# Get the criterion value
GetCrit(i_sim_manu)
# Graphical assessment of the calibration performance
plot(i_sim_manu)
## ----v00_fig_cal_auto, echo=TRUE, eval=TRUE, fig.width=7*1.5, fig.height=5*1.5, out.width='98%'----
# Calibration using NSE score
cal_auto <- CalGR(PrepGR = prep,
CalCrit = "NSE",
WupPer = c("1999-01-01", "2000-12-31"),
CalPer = c("2001-01-01", "2010-12-31"))
# Get parameter and criteria values at the end of the calibration step
GetParam(cal_auto)
GetCrit(cal_auto)
# Graphical assessment of the calibration performance
plot(cal_auto)
## ----v00_fig_cal_eval, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Catchment data loading
data("X031001001", package = "airGRdatasets")
# Observed daily time series
ts_obs <- X031001001$TS
# Catchment elevation distribution
hypso <- X031001001$Hypso
# Temporal subset
is_per <- ts_obs$Date >= as.POSIXct("1999-01-01", tz = "UTC") &
ts_obs$Date <= as.POSIXct("2009-12-30", tz = "UTC")
ts_obs <- ts_obs[is_per, ]
# Data processing for GR4J (without snow module)
prep_snow_n <- PrepGR(DatesR = ts_obs$Date,
Precip = ts_obs$Ptot,
PotEvap = ts_obs$Evap,
Qobs = ts_obs$Qmmd,
HydroModel = "GR4J",
CemaNeige = FALSE)
# Data processing for GR4J with snow module
prep_snow_y <- PrepGR(DatesR = ts_obs$Date,
Precip = ts_obs$Ptot,
PotEvap = ts_obs$Evap,
Qobs = ts_obs$Qmmd,
TempMean = ts_obs$Temp,
ZInputs = median(hypso),
HypsoData = hypso,
NLayers = 5,
HydroModel = "GR4J",
CemaNeige = TRUE)
# Calibration using NSE score (without snow module)
cal_snow_n <- CalGR(PrepGR = prep_snow_n,
CalCrit = "NSE",
WupPer = c("1999-01-01", "2000-12-31"),
CalPer = c("2001-01-01", "2009-12-30"),
verbose = TRUE)
# Calibration using NSE score (with snow module)
cal_snow_y <- CalGR(PrepGR = prep_snow_y,
CalCrit = "NSE",
WupPer = c("1999-01-01", "2000-12-31"),
CalPer = c("2001-01-01", "2009-12-30"),
verbose = TRUE)
# Combination of observed and simulated streamflow
tab_cal <- data.frame(Date = cal_snow_n$OutputsModel$DatesR,
QOobs = cal_snow_n$Qobs,
Qsim_snow_n = cal_snow_n$OutputsModel$Qsim,
Qsim_snow_y = cal_snow_y$OutputsModel$Qsim)
# Computation of regime streamflow
tab_cal_reg <- SeriesAggreg(tab_cal,
Format = "%m",
ConvertFun = rep("mean", ncol(tab_cal) - 1))
# Graphical comparison between simulated and observed streamflow regimes
col_snow <- c("black", rep("orangered", 2))
lty_snow <- c(1, 1:2)
matplot(y = tab_cal_reg[, grep("^Q", colnames(tab_cal))],
xlab = "time [months]", ylab = "flow [mm/d]",
type = "l", lty = lty_snow, lwd = 2, col = col_snow)
legend("topright",
legend = c("Qobs", "Qsim without snow mod.", "Qsim with snow mod."),
lty = lty_snow, lwd = 2, col = col_snow,
bg = "white")
## ----v00_fig_flow_transfo, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Catchment data loading
data("B222001001", package = "airGRdatasets")
ts_obs <- B222001001$TS
# Data processing for GR4J (with Q for calibration)
prep <- PrepGR(DatesR = ts_obs$Date,
Precip = ts_obs$Ptot,
PotEvap = ts_obs$Evap,
Qobs = ts_obs$Qmmd,
HydroModel = "GR4J",
CemaNeige = FALSE)
# Calibration using NSE score on raw Q
cal_raw <- CalGR(PrepGR = prep,
CalCrit = "NSE",
transfo = "",
WupPer = c("1999-01-01", "2001-12-31"),
CalPer = c("2002-01-01", "2016-12-31"))
# Calibration using NSE score on sqrt(Q)
cal_sqrt <- CalGR(PrepGR = prep,
CalCrit = "NSE",
transfo = "sqrt",
WupPer = c("1999-01-01", "2001-12-31"),
CalPer = c("2002-01-01", "2016-12-31"))
# Calibration using NSE score on log(Q)
cal_log <- CalGR(PrepGR = prep,
CalCrit = "NSE",
transfo = "log",
WupPer = c("1999-01-01", "2001-12-31"),
CalPer = c("2002-01-01", "2016-12-31"))
# Combination of simulated streamflow
tab_sim_trsf <- data.frame(Date = cal_raw$OutputsModel$DatesR,
QSIM_rawQ = cal_raw$OutputsModel$Qsim,
QSIM_sqrtQ = cal_sqrt$OutputsModel$Qsim,
QSIM_logQ = cal_log$OutputsModel$Qsim)
tab_sim_trsf <- merge(x = ts_obs[, c("Date", "Qmmd")],
y = tab_sim_trsf,
by = "Date",
all.y = TRUE)
# Computation of regime streamflow
tab_sim_reg <- SeriesAggreg(tab_sim_trsf,
Format = "%m",
ConvertFun = rep("mean", ncol(tab_sim_trsf) - 1))
# Graphical comparison between simulated and observed streamflow regimes
col_trsf <- c("black", rep("orangered", 3))
lty_trsf <- c(1, 1:3)
matplot(y = tab_sim_reg[, -1],
xlab = "time [months]", ylab = "flow [mm/d]",
type = "l", lty = lty_trsf, lwd = 2, col = col_trsf)
legend("bottomleft",
legend = c("Qobs", "Qsim", "sqrt(Qsim)", "log(Qsim)"),
lty = lty_trsf, lwd = 2, col = col_trsf,
bg = "white")
## ----v00_fig_obj_fun, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Calibration using NSE score on Q
cal_nse <- CalGR(PrepGR = prep,
CalCrit = "NSE",
transfo = "",
WupPer = c("1999-01-01", "2001-12-31"),
CalPer = c("2002-01-01", "2016-12-31"))
# Calibration using KGE score on Q
cal_kge <- CalGR(PrepGR = prep,
CalCrit = "KGE",
transfo = "",
WupPer = c("1999-01-01", "2001-12-31"),
CalPer = c("2002-01-01", "2016-12-31"))
# Combination of observed and simulated streamflow
tab_crit <- data.frame(Date = as.POSIXct(cal_nse$OutputsModel$DatesR),
Qobs = cal_nse$Qobs,
Qsim_nse = cal_nse$OutputsModel$Qsim,
Qsim_kge = cal_kge$OutputsModel$Qsim)
# Graphical comparison
col_crit <- c("black", rep("orangered", 2))
lty_crit <- c(1, 1:2)
matplot(x = tab_crit$Date, y = tab_crit[, -1],
xlab = "time [d]", ylab = "flow [mm/d]",
type = "l", lty = lty_crit, lwd = 2, col = col_crit,
xlim = as.POSIXct(x = c("2004-01-01", "2004-03-01"), tz = "UTC"))
legend("topleft",
legend = c("Qobs", "Qsim NSE", "Qsim KGE"),
lty = lty_crit, lwd = 2, col = col_crit,
bg = "white")
## ----v00_fig_sst, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Calibration and evaluation sub-periods
per1_wup <- c("1999-01-01", "2001-12-31")
per1_sim <- c("2002-01-01", "2008-12-31")
per2_wup <- c("2009-01-01", "2011-12-31")
per2_sim <- c("2012-01-01", "2018-12-31")
# Calibration on per1 and per2
cal_per1 <- CalGR(PrepGR = prep,
CalCrit = "KGE",
transfo = "",
WupPer = per1_wup,
CalPer = per1_sim,
verbose = TRUE)
cal_per2 <- CalGR(PrepGR = prep,
CalCrit = "KGE",
transfo = "",
WupPer = per2_wup,
CalPer = per2_sim,
verbose = TRUE)
# Get parameter values at the end of the calibration step
param_per1 <- GetParam(cal_per1)
param_per2 <- GetParam(cal_per2)
# Get criteria values at the end of the calibration step
crit_cal_per1 <- GetCrit(cal_per1)
crit_cal_per2 <- GetCrit(cal_per2)
# Evaluation over per1 and per2
eva_per1 <- SimGR(PrepGR = prep,
Param = param_per2,
WupPer = per1_wup,
SimPer = per1_sim,
EffCrit = "KGE",
verbose = TRUE)
eva_per2 <- SimGR(PrepGR = prep,
Param = param_per1,
WupPer = per2_wup,
SimPer = per2_sim,
EffCrit = "KGE",
verbose = TRUE)
# Get criteria values
crit_eva_per1 <- GetCrit(eva_per1)
crit_eva_per2 <- GetCrit(eva_per2)
# Cleveland dot plot of the criteria
dotchart(c(crit_eva_per1, crit_cal_per1, crit_eva_per2, crit_cal_per2),
labels = c("eva (per1)", "cal (per1)", "eva (per2)", "cal (per2)"),
groups = rep(1:2, each = 2),
col = rep(c("darkred", "darkblue"), each = 2), pch = 19,
xlab = "KGE [-]")
## ----v00_fig_dsst, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=3*3, fig.height=3*1.7, out.width='98%'----
# Estimation of annual aridity index (PE/P)
ts_obs_y <- SeriesAggreg(x = ts_obs[, c("Date", "Ptot", "Evap")],
Format = "%Y",
ConvertFun = c("sum", "sum"),
YearFirstMonth = 10)
ts_obs_y$Arid <- ts_obs_y$Evap / ts_obs_y$Ptot
# Identification of wetter and dryer hydrological years
barplot(height = ts_obs_y$Arid,
names.arg = format(ts_obs_y$Date, format = "%Y"),
xlab = "time [yr]", ylab = "aridity index [-]",
col = "royalblue")
# Wet and dry periods
per_wet <- c("2016-10-01", "2017-09-30")
per_dry <- c("2000-10-01", "2001-09-30")
# Calibration over the wet and the dry periods
cal_wet <- CalGR(PrepGR = prep,
CalCrit = "KGE",
CalPer = per_wet,
verbose = TRUE)
cal_dry <- CalGR(PrepGR = prep,
CalCrit = "KGE",
CalPer = per_dry,
verbose = TRUE)
# Get parameter values at the end of the calibration step
param_dry <- GetParam(cal_dry)
param_wet <- GetParam(cal_wet)
# Get criteria values at the end of the calibration step
crit_cal_dry <- GetCrit(cal_dry)
crit_cal_wet <- GetCrit(cal_wet)
# Evaluation over the wet and the dry periods
eva_wet <- SimGR(PrepGR = prep,
Param = cal_dry,
SimPer = per_wet,
EffCrit = "KGE",
verbose = TRUE)
eva_dry <- SimGR(PrepGR = prep,
Param = cal_wet,
SimPer = per_dry,
EffCrit = "KGE",
verbose = TRUE)
# Get criteria values
crit_eva_dry <- GetCrit(eva_dry)
crit_eva_wet <- GetCrit(eva_wet)
# Cleveland dot plot of the criteria
dotchart(c(crit_eva_dry, crit_cal_dry, crit_eva_wet, crit_cal_wet),
labels = c("eva (dry)", "cal (dry)", "eva (wet)", "cal (wet)"),
col = rep(c("darkorange", "deepskyblue3"), each = 2), pch = 19,
xlab = "KGE [-]")