## ----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") ## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set(echo = TRUE, fig.path = "figure/") Sys.setlocale("LC_TIME", "fr_FR.UTF-8") library(airGRteaching) 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 } } ## ----format_ts_1, eval=TRUE, echo=FALSE, results='hide'----------------------- # Catchment data loading library(airGRdatasets) data("Y643401001", package = "airGRdatasets") # Catchment metadata str(Y643401001$Meta) # Observed daily time series ts_obs_d <- Y643401001$TS # Summary of the time series summary(ts_obs_d) ## ----include=FALSE------------------------------------------------------------ area <- Y643401001$Meta$Area name_sta <- gsub("the ", "", Y643401001$Meta$Name) name_riv <- gsub("(the )(.*)( at.*)", "\\2", name_sta) year_na <- format(ts_obs_d[is.na(ts_obs_d$Qmmd), "Date"], format = "%Y") year_na <- names(sort(table(year_na), decreasing = TRUE)[1]) ## ----v01_set_per, eval=TRUE, echo=FALSE--------------------------------------- # Calibration period per_cal_wup <- c("2003-01-01", "2004-12-01") per_cal_run <- c("2005-01-01", "2010-12-01") # Evaluation period per_eva_wup <- c("2009-01-01", "2010-12-01") per_eva_run <- c("2011-01-01", "2018-12-01") # Simulation period per_sim_wup <- c("1999-01-01", "2000-12-01") per_sim_run <- c("2001-01-01", "2018-12-01") ## ----v01_regime, eval=TRUE, echo=FALSE---------------------------------------- # Monthly aggregation of observed daily time series ts_obs_m <- SeriesAggreg(ts_obs_d[, c("Date", "Ptot", "Evap", "Qmmd", "Temp")], Format = "%Y%m", ConvertFun = c("sum", "sum", "sum", "mean")) ## ----eval=TRUE, echo=FALSE---------------------------------------------------- # Information for the vignette per_all_pct <- range(ts_obs_m$Date) per_all_for <- format(range(ts_obs_m$Date), format = "%Y") per_cal_wup_pct <- as.POSIXct(per_cal_wup, tz = "UTC") per_cal_wup_for <- format(per_cal_wup_pct, format = "%B %Y") per_cal_run_pct <- as.POSIXct(per_cal_run, tz = "UTC") per_cal_run_for <- format(per_cal_run_pct, format = "%B %Y") per_eva_wup_pct <- as.POSIXct(per_eva_wup, tz = "UTC") per_eva_wup_for <- format(per_eva_wup_pct, format = "%B %Y") per_eva_run_pct <- as.POSIXct(per_eva_run, tz = "UTC") per_eva_run_for <- format(per_eva_run_pct, format = "%B %Y") per_sim_wup_pct <- as.POSIXct(per_sim_wup, tz = "UTC") per_sim_wup_for <- format(per_sim_wup_pct, format = "%B %Y") per_sim_run_pct <- as.POSIXct(per_sim_run, tz = "UTC") per_sim_run_for <- format(per_sim_run_pct, format = "%B %Y") ## ----v01_fig_presentation, echo=FALSE, eval=TRUE, fig.width=7*1.5, fig.height=3*1.5, dev.args=list(pointsize=12), out.width='98%'---- ind_na <- as.matrix(airGRteaching:::.StartStop(ts_obs_m$Qmmd, FUN = is.na)) plot(x = ts_obs_m$Date, y = ts_obs_m$Qmmd, xlab = "time [months]", ylab = "flow [mm/month]", type = "l", lwd = 1, panel.first = rect(xleft = ts_obs_m$Date[ind_na[, 1]], ybottom = -1e6, xright = ts_obs_m$Date[ind_na[, 2]], ytop = +1e6, col = "lightgrey", border = NA)) text(x = ts_obs_m$Date[floor(apply(ind_na, MARGIN = 1, median))], y = quantile(range(ts_obs_m$Qmmd, na.rm = TRUE), probs = 0.75), labels = "?", cex = 8, font = 2, col = "orangered") ## ----format_ts_1, echo=TRUE--------------------------------------------------- # Catchment data loading library(airGRdatasets) data("Y643401001", package = "airGRdatasets") # Catchment metadata str(Y643401001$Meta) # Observed daily time series ts_obs_d <- Y643401001$TS # Summary of the time series summary(ts_obs_d) ## ----v01_set_per, echo=TRUE--------------------------------------------------- # Calibration period per_cal_wup <- c("2003-01-01", "2004-12-01") per_cal_run <- c("2005-01-01", "2010-12-01") # Evaluation period per_eva_wup <- c("2009-01-01", "2010-12-01") per_eva_run <- c("2011-01-01", "2018-12-01") # Simulation period per_sim_wup <- c("1999-01-01", "2000-12-01") per_sim_run <- c("2001-01-01", "2018-12-01") ## ----v01_regime, echo=TRUE---------------------------------------------------- # Monthly aggregation of observed daily time series ts_obs_m <- SeriesAggreg(ts_obs_d[, c("Date", "Ptot", "Evap", "Qmmd", "Temp")], Format = "%Y%m", ConvertFun = c("sum", "sum", "sum", "mean")) ## ----echo=TRUE, eval=TRUE, warning=FALSE-------------------------------------- # Data processing for GR2M prep <- PrepGR(DatesR = ts_obs_m$Date, Precip = ts_obs_m$Ptot, PotEvap = ts_obs_m$Evap, Qobs = ts_obs_m$Qmmd, HydroModel = "GR2M", CemaNeige = FALSE) ## ----echo=TRUE, eval=TRUE----------------------------------------------------- # Parameter set to test i_param_gr2m <- c(X1 = 380, X2 = 0.92) # Simulation over the calibration period i_sim_manu <- SimGR(PrepGR = prep, Param = i_param_gr2m, EffCrit = "NSE", WupPer = per_cal_wup, SimPer = per_cal_run, verbose = TRUE) ## ----echo=TRUE, eval=TRUE----------------------------------------------------- # Calibration criterion GetCrit(i_sim_manu) ## ----v01_fig_cal_manu_gr2m, echo=TRUE, eval=TRUE, warning=FALSE, fig.width=7*1.5, fig.height=5*1.5, dev.args=list(pointsize=16), out.width='98%'---- # Graphical assessment of the calibration performance plot(i_sim_manu) ## ----v01_fig_cal_auto_gr2m, echo=TRUE, eval=TRUE, fig.width=7*1.5, fig.height=5*1.5, dev.args=list(pointsize=16), out.width='98%'---- # Calibration cal_auto <- CalGR(PrepGR = prep, CalCrit = "NSE", WupPer = per_cal_wup, CalPer = per_cal_run, verbose = TRUE) # Graphical assessment of the calibration performance plot(cal_auto) ## ----echo=TRUE, eval=TRUE----------------------------------------------------- # Get parameter values param_cal <- GetParam(cal_auto) param_cal ## ----echo=TRUE, eval=TRUE----------------------------------------------------- # Get criterion value GetCrit(cal_auto) ## ----v01_ts_q, echo=TRUE, eval=TRUE------------------------------------------- # Combination of observed and simulated streamflow time series on the calibration period ts_cal <- as.data.frame(cal_auto) # Combination of observed and simulated streamflow time series on the entire period ts_cal_all <- merge(x = ts_obs_m[, "Date", drop = FALSE], y = ts_cal, by.x = "Date", by.y = "Dates", all.x = TRUE) ## ----v01_fig_cal, echo=FALSE, eval=TRUE, fig.width=7*1.5, fig.height=3*1.5, dev.args=list(pointsize=12), out.width='98%'---- ind_wup <- ts_obs_m$Date >= per_cal_wup_pct[1] & ts_obs_m$Date <= per_cal_run_pct[1] ind_wup <- range(which(ind_wup)) plot(x = ts_obs_m$Date, y = ts_obs_m$Qmmd, xlab = "time [months]", ylab = "flow [mm/month]", main = "Simulation on the calibration period", type = "l", lwd = 1, panel.first = list(rect(xleft = ts_obs_m$Date[ind_na[, 1]], ybottom = -1e6, xright = ts_obs_m$Date[ind_na[, 2]], ytop = +1e6, col = "lightgrey", border = NA), rect(xleft = ts_obs_m$Date[ind_wup[1]], ybottom = -1e6, xright = ts_obs_m$Date[ind_wup[2]], ytop = +1e6, col = adjustcolor("orangered", 0.6), border = NA))) lines(ts_cal$Date, ts_cal$Qsim, lwd = 1, col = "orangered") legend("topright", legend = c("Qobs", "Qsim", "warm-up", "NA"), pch = c(NA, NA, 15, 15), lwd = c(1, 1, NA, NA), pt.cex = c(NA, NA, 2, 2), col = c("black", "orangered", adjustcolor("orangered", 0.6), "lightgray"), bg = "white") ## ----v01_eval, echo=TRUE, eval=TRUE------------------------------------------- # Simulation over the evaluation period eva <- SimGR(PrepGR = prep, Param = param_cal, WupPer = per_eva_wup, SimPer = per_eva_run, EffCrit = "NSE", verbose = FALSE) # Get the criterion value GetCrit(eva) # Combination of observed and simulated streamflow time series ts_eva <- as.data.frame(eva) ## ----v01_fig_eval, echo=FALSE, eval=TRUE, fig.width=7*1.5, fig.height=3*1.5, dev.args=list(pointsize=12), out.width='98%'---- ind_wup <- range(which(ts_obs_m$Date >= per_eva_wup_pct[1] & ts_obs_m$Date <= per_eva_run_pct[1])) plot(x = ts_obs_m$Date, y = ts_obs_m$Qmmd, xlab = "time [months]", ylab = "flow [mm/month]", main = "Simulation on the evaluation period", type = "l", lwd = 1, panel.first = list(rect(xleft = ts_obs_m$Date[ind_na[, 1]], ybottom = -1e6, xright = ts_obs_m$Date[ind_na[, 2]], ytop = +1e6, col = "lightgrey", border = NA), rect(xleft = ts_obs_m$Date[ind_wup[1]], ybottom = -1e6, xright = ts_obs_m$Date[ind_wup[2]], ytop = +1e6, col = adjustcolor("orangered", 0.6), border = NA))) lines(ts_eva$Date, ts_eva$Qsim, lwd = 1, col = "orangered") legend("topright", legend = c("Qobs", "Qsim", "warm-up", "NA"), pch = c(NA, NA, 15, 15), lwd = c(1, 1, NA, NA), pt.cex = c(NA, NA, 2, 2), col = c("black", "orangered", adjustcolor("orangered", 0.6), "lightgray"), bg = "white") ## ----v01_sim, echo=TRUE, eval=TRUE-------------------------------------------- # Simulation over the entire period sim <- SimGR(PrepGR = prep, Param = param_cal, WupPer = per_sim_wup, SimPer = per_sim_run, EffCrit = "NSE", verbose = FALSE) ## ----echo=TRUE, eval=TRUE----------------------------------------------------- # Get the criterion value GetCrit(sim) # Combination of observed and simulated streamflow time series ts_sim <- as.data.frame(sim) ## ----v01_fig_sim, echo=FALSE, eval=TRUE, fig.width=7*1.5, fig.height=3*1.5, dev.args=list(pointsize=12), out.width='98%'---- ind_wup <- range(which(ts_obs_m$Date >= per_sim_wup_pct[1] & ts_obs_m$Date <= per_sim_run_pct[1])) plot(x = ts_obs_m$Date, y = ts_obs_m$Qmmd, xlab = "time [months]", ylab = "flow [mm/month]", main = "Simulation on the entire period", type = "l", lwd = 1, panel.first = list(rect(xleft = ts_obs_m$Date[ind_na[, 1]], ybottom = -1e6, xright = ts_obs_m$Date[ind_na[, 2]], ytop = +1e6, col = "lightgrey", border = NA), rect(xleft = ts_obs_m$Date[ind_wup[1]], ybottom = -1e6, xright = ts_obs_m$Date[ind_wup[2]], ytop = +1e6, col = adjustcolor("orangered", 0.6), border = NA))) lines(ts_sim$Date, ts_sim$Qsim, lwd = 1, col = "orangered") legend("topright", legend = c("Qobs", "Qsim", "warm-up", "NA"), pch = c(NA, NA, 15, 15), lwd = c(1, 1, NA, NA), pt.cex = c(NA, NA, 2, 2), col = c("black", "orangered", adjustcolor("orangered", 0.6), "lightgray"), bg = "white")