diff --git a/.Rbuildignore b/.Rbuildignore index d091221025aabc068c663201da3ef2111e199638..b0c59e037a32865345f6a68504e5bf226bb2685f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,5 +1,6 @@ ^griwrm\.Rproj$ ^\.Rproj\.user$ ^LICENSE\.md$ -\.gitlab-ci\.yml -R_LIBS +^\.gitlab-ci\.yml$ +^R_LIBS +^vignettes/_cache diff --git a/.gitignore b/.gitignore index de3a5744bd3f47a5d1338aae01b8796290369a17..9cc706754ddbe1cf4c7e2863f3220750bf337fa2 100644 --- a/.gitignore +++ b/.gitignore @@ -5,6 +5,7 @@ # Man pages generated by Roxygen man/*.Rd /.vscode/ +/NAMESPACE ############################################################################### diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index e79f408364c81f1a7856f794e45949f5e665f5a7..27e2d6d6ac1b8f661d60c1aad82e01179cc4c9b8 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -20,12 +20,15 @@ update_packages: script: - mkdir -p R_LIBS - Rscript -e 'if(!dir.exists("R_LIBS/remotes")) install.packages("remotes", lib = "R_LIBS")' - - Rscript -e 'remotes::update_packages(c("dplyr", "rmarkdown", "readr", "lubridate", "zoo"), lib = "R_LIBS")' + - apt-get update && apt-get -y install libxml2-dev + - Rscript -e 'remotes::update_packages(c("dplyr", "rmarkdown", "readr", "lubridate", "zoo", "roxygen2"), lib = "R_LIBS")' - Rscript -e 'remotes::install_gitlab("HYCAR-Hydro/airgr@sd", host = "gitlab.irstea.fr", lib = "R_LIBS")' build: stage: build script: + - apt-get update && apt-get -y install libxml2-dev + - Rscript -e "roxygen2::roxygenise()" - R CMD build ../griwrm artifacts: paths: diff --git a/DESCRIPTION b/DESCRIPTION index 28ae94d3a0e00b109594a6ce5eaed7accbae6152..b4f18fc58f7383911324d8099b49c44be93e4230 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: griwrm Title: GR based Integrated Water Resource Management -Version: 0.2.0 +Version: 0.2.1 Authors@R: person(given = "David", family = "Dorchies", diff --git a/NAMESPACE b/NAMESPACE deleted file mode 100644 index 32655fdc89b910c2ae7be4f290d8ad87c5af7d12..0000000000000000000000000000000000000000 --- a/NAMESPACE +++ /dev/null @@ -1,26 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -S3method(Calibration,GriwrmInputsModel) -S3method(Calibration,InputsModel) -S3method(CreateCalibOptions,GriwrmInputsModel) -S3method(CreateCalibOptions,InputsModel) -S3method(CreateInputsCrit,GriwrmInputsModel) -S3method(CreateInputsCrit,InputsModel) -S3method(CreateInputsModel,Griwrm) -S3method(CreateInputsModel,default) -S3method(CreateRunOptions,GriwrmInputsModel) -S3method(CreateRunOptions,InputsModel) -S3method(RunModel,GriwrmInputsModel) -S3method(RunModel,InputsModel) -S3method(merge,Gits) -export(Calibration) -export(CreateCalibOptions) -export(CreateInputsCrit) -export(CreateInputsModel) -export(CreateRunOptions) -export(Ginet) -export(Girop) -export(Gits) -export(RunModel) -export(getNodeRanking) -import(airGR) diff --git a/R/Calibration.InputsModel.R b/R/Calibration.InputsModel.R index 6520ab81cf8716f89c4cba8f85841b8ff680e188..1eab94bd1da6c32d0f80c527f157686827088ccd 100644 --- a/R/Calibration.InputsModel.R +++ b/R/Calibration.InputsModel.R @@ -1,9 +1,6 @@ -#' Wrapper to \code{\link[airGR]{Calibration}}. +#' Wrapper to \code{\link[airGR]{Calibration}} for one sub-basin. #' -#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details. -#' @param ... further arguments passed to \code{\link[airGR]{Calibration}}. -#' -#' @return \emph{CalibOutput} object. +#' @inherit airGR::Calibration #' @export Calibration.InputsModel <- function(InputsModel, ...) { airGR::Calibration(InputsModel, FUN_MOD = InputsModel$FUN_MOD, ...) diff --git a/R/CreateCalibOptions.InputsModel.R b/R/CreateCalibOptions.InputsModel.R index b8fc8a6b64332edc50a4c79328204e178920b2e0..f31e3c439169ae412427b9764710959459d12a9a 100644 --- a/R/CreateCalibOptions.InputsModel.R +++ b/R/CreateCalibOptions.InputsModel.R @@ -1,9 +1,6 @@ -#' Wrapper to \code{\link[airGR]{CreateCalibOptions}} +#' Wrapper to \code{\link[airGR]{CreateCalibOptions}} for one sub-basin. #' -#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details. -#' @param ... further arguments passed to \code{\link[airGR]{CreateCalibOptions}}. -#' -#' @return \emph{CalibOptions} object. +#' @inherit airGR::CreateCalibOptions #' @export CreateCalibOptions.InputsModel <- function(InputsModel, ...) { diff --git a/R/CreateInputsCrit.GriwrmInputsModel.R b/R/CreateInputsCrit.GriwrmInputsModel.R index db1769fd458dfcddfdbbac1f8cae75023cc8e282..d1cb9b57655b41edf243eb8c4ab440560e65ff7f 100644 --- a/R/CreateInputsCrit.GriwrmInputsModel.R +++ b/R/CreateInputsCrit.GriwrmInputsModel.R @@ -2,7 +2,7 @@ #' @param InputsModel object of class \emph{GriwrmInputsModel}, see \code{\link{CreateInputsModel.Griwrm}} for details. #' @param FUN_CRIT \[function (atomic or list)\] error criterion function (e.g. \code{\link[airGR]{ErrorCrit_RMSE}}, \code{\link[airGR]{ErrorCrit_NSE}}) #' @param RunOptions object of class \emph{GriwrmRunOptions}, see \code{[CreateRunOptions.Griwrm]} for details. -#' @param gits object of class \emph{Gits}, see [Gits]. +#' @param Qobs matrix or data frame containing observed flows. Column names correspond to nodes ID #' @param ... further arguments passed to \code{\link[airGR]{CreateInputsCrit}}. #' #' @return Object of class \emph{GriwrmInputsCrit} @@ -10,7 +10,7 @@ CreateInputsCrit.GriwrmInputsModel <- function(InputsModel, FUN_CRIT = airGR::ErrorCrit_NSE, RunOptions, - gits, + Qobs, ...) { InputsCrit <- list() class(InputsCrit) <- append(class(InputsCrit), "GriwrmInputsCrit") @@ -20,7 +20,7 @@ CreateInputsCrit.GriwrmInputsModel <- function(InputsModel, InputsModel = IM, FUN_CRIT = FUN_CRIT, RunOptions = RunOptions[[IM$id]], - Obs = gits[[IM$id]]$Qobs[RunOptions[[IM$id]]$IndPeriod_Run], + Obs = Qobs[RunOptions[[IM$id]]$IndPeriod_Run, IM$id], ... ) } diff --git a/R/CreateInputsCrit.InputsModel.R b/R/CreateInputsCrit.InputsModel.R index f1a337bd590af5facae220e6f70861badd5664d4..b4780ef0716b910b788071bedafb30bf46bdd6bc 100644 --- a/R/CreateInputsCrit.InputsModel.R +++ b/R/CreateInputsCrit.InputsModel.R @@ -1,10 +1,6 @@ -#' Wrapper to \code{\link[airGR]{CreateInputsCrit}} +#' Wrapper to \code{\link[airGR]{CreateInputsCrit}} for one sub-basin. #' -#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details. -#' @param FUN_CRIT \[function (atomic or list)\] error criterion function (e.g. \code{\link[airGR]{ErrorCrit_RMSE}}, \code{\link[airGR]{ErrorCrit_NSE}}) -#' @param ... further arguments passed to \code{\link[airGR]{CreateInputsCrit}} -#' -#' @return object of class \emph{InputsCrit} containing the data required to evaluate the model outputs. See \code{\link[airGR]{CreateInputsCrit}} +#' @inherit airGR::CreateInputsCrit #' @export CreateInputsCrit.InputsModel <- function(InputsModel, FUN_CRIT, diff --git a/R/CreateInputsModel.Griwrm.R b/R/CreateInputsModel.Griwrm.R index 13c80194bfca9fa2e9b67a0d29db29b39e535333..8395318780f5da1737de66467bda4bb8a9145d6b 100644 --- a/R/CreateInputsModel.Griwrm.R +++ b/R/CreateInputsModel.Griwrm.R @@ -1,20 +1,25 @@ #' Create InputsModel object for a GRIWRM network #' -#' @param x Ginet object describing the diagram of the semi-distributed model, see \code{[Ginet]}. -#' @param girop Girop object giving the run-off model parameters, see \code{[Girop]}. -#' @param gits Gits object giving the observation time series, see \code{[Gits]}. +#' @param x Griwrm object describing the diagram of the semi-distributed model, see \code{[Griwrm]}. +#' @param DateR Vector of POSIXlt observation time steps. +#' @param Precip Matrix or data frame of numeric containing precipitation in mm. Column names correspond to node IDs. +#' @param PotEvap Matrix or data frame of numeric containing potential evaporation in mm. Column names correspond to node IDs. +#' @param Qobs Matrix or data frame of numeric containing potential observed flow in mm. Column names correspond to node IDs. #' @param verbose (optional) boolean indicating if the function is run in verbose mode or not, default = \code{TRUE} #' @param ... further arguments passed to \code{\link[airGR]{CreateInputsModel}}. #' #' @return GriwrmInputsModel object equivalent to airGR InputsModel object for a semi-distributed model (See \code{\link[airGR]{CreateInputsModel}}) #' @export -CreateInputsModel.Griwrm <- function(x, girop, gits, verbose = TRUE, ...) { +CreateInputsModel.Griwrm <- function(x, DatesR, Precip, PotEvap, Qobs, verbose = TRUE, ...) { InputsModel <- CreateEmptyGriwrmInputsModel() + Qobs[is.na(Qobs)] <- -99 # airGRCreateInputsModel doesn't accept NA values for(id in getNodeRanking(x)) { if(verbose) cat("CreateInputsModel.griwrm: Treating sub-basin", id, "...\n") - InputsModel[[id]] <- CreateOneGriwrmInputsModel(id, x, girop, gits, ...) + InputsModel[[id]] <- CreateOneGriwrmInputsModel( + id, x, DatesR,Precip[,id], PotEvap[,id], Qobs, ... + ) } return(InputsModel) } @@ -33,17 +38,19 @@ CreateEmptyGriwrmInputsModel <- function() { #' Create one InputsModel for a GRIWRM node #' #' @param id string of the node identifier -#' @param ginet See \code{[Ginet]}. -#' @param girop See \code{[Girop]}. -#' @param gits See \code{[Gits]}. -#' +#' @param griwrm See \code{[Griwrm]}. +#' @param DatesR vector of dates required to create the GR model and CemaNeige module inputs. +#' @param Precip time series of potential evapotranspiration (catchment average) (mm/time step). +#' @param PotEvap time series of potential evapotranspiration (catchment average) (mm/time step). +#' @param Qobs Matrix or data frame of numeric containing observed flow (mm/time step). Column names correspond to node IDs. +##' #' @return \emph{InputsModel} object for one. -CreateOneGriwrmInputsModel <- function(id, ginet, girop, gits) { - node <- ginet[ginet$id == id,] - FUN_MOD <- girop$model[girop$id == id] +CreateOneGriwrmInputsModel <- function(id, griwrm, DatesR, Precip, PotEvap, Qobs) { + node <- griwrm[griwrm$id == id,] + FUN_MOD <- griwrm$model[griwrm$id == id] # Set hydraulic parameters - UpstreamNodes <- ginet$id[ginet$down == id & !is.na(ginet$down)] + UpstreamNodes <- griwrm$id[griwrm$down == id & !is.na(griwrm$down)] Qupstream <- NULL LengthHydro <- NULL BasinAreas <- NULL @@ -51,26 +58,26 @@ CreateOneGriwrmInputsModel <- function(id, ginet, girop, gits) { if(length(UpstreamNodes) > 0) { # Sub-basin with hydraulic routing for(idUpstrNode in UpstreamNodes) { - Qupstream1 <- matrix(gits[[idUpstrNode]]$Qobs, ncol = 1) + Qupstream1 <- matrix(Qobs[,idUpstrNode], ncol = 1) if(is.null(Qupstream)) { Qupstream <- Qupstream1 } else { Qupstream <- cbind(Qupstream, Qupstream1) } } - LengthHydro <- ginet$length[girop$id %in% UpstreamNodes] + LengthHydro <- griwrm$length[griwrm$id %in% UpstreamNodes] BasinAreas <- c( - girop$area[girop$id %in% UpstreamNodes], - girop$area[girop$id == id] - sum(girop$area[girop$id %in% UpstreamNodes]) + griwrm$area[griwrm$id %in% UpstreamNodes], + node$area - sum(griwrm$area[griwrm$id %in% UpstreamNodes]) ) } # Set model inputs with the airGR function InputsModel <- CreateInputsModel( FUN_MOD, - DatesR = gits$date, - Precip = gits[[id]]$Precip, - PotEvap = gits[[id]]$PotEvap, + DatesR = DatesR, + Precip = Precip, + PotEvap = PotEvap, Qupstream = Qupstream, LengthHydro = LengthHydro, BasinAreas = BasinAreas diff --git a/R/CreateInputsModel.default.R b/R/CreateInputsModel.default.R index 3b3e5bab1c9ac8f57576a50b8c09d45b261624e0..bffeb90a94810a6db443d0fbf457b10cf6c2ce2a 100644 --- a/R/CreateInputsModel.default.R +++ b/R/CreateInputsModel.default.R @@ -1,12 +1,8 @@ -#' Wrapper for the airGR::CreateInputsModel function +#' Wrapper for \code{\link[airGR]{CreateInputsModel}} for one sub-basin. #' -#' @param x hydrological model function (e.g. \code{\link[airGR]{RunModel_GR4J}}, \code{\link[airGR]{RunModel_CemaNeigeGR4J}}) -#' @param ... further arguments passed to \code{\link[airGR]{CreateInputsModel}}. -#' -#' @return object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details. +#' @inherit airGR::CreateInputsModel #' @import airGR #' @export -#' @seealso The original function in airGR package: \code{\link[airGR]{CreateInputsModel}}. #' CreateInputsModel.default <- function(x, ...) { diff --git a/R/CreateRunOptions.InputsModel.R b/R/CreateRunOptions.InputsModel.R index ef6979194d59f0ded0589e2c4b3d2b55f00a2891..5ec199179131c0f7db963c02dfbcd36609273608 100644 --- a/R/CreateRunOptions.InputsModel.R +++ b/R/CreateRunOptions.InputsModel.R @@ -1,9 +1,6 @@ -#' Create \emph{RunOptions} object for airGR. See \code{\link[airGR]{CreateOptions}}. +#' Wrapper for \code{\link[airGR]{CreateRunOptions}} for one sub-basin. #' -#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details. -#' @param ... further arguments passed to \code{\link[airGR]{CreateOptions}}. -#' -#' @return See \code{\link[airGR]{CreateOptions}}. +#' @inherit airGR::CreateRunOptions #' @export CreateRunOptions.InputsModel <- function(InputsModel, ...) { diff --git a/R/ginet.R b/R/Griwrm.R similarity index 68% rename from R/ginet.R rename to R/Griwrm.R index 15512295019177dae7f2a5e1bdddb65deb93bd23..28665823ee3adacefdc62f73a755d20a029eed49 100644 --- a/R/ginet.R +++ b/R/Griwrm.R @@ -5,35 +5,35 @@ #' @param cols named list or vector for matching columns of `db` parameter. By default, mandatory columns names are: `id`, `down`, `length`. But other names can be handled with a named list or vector containing items defined as `"required name" = "column name in db"`. #' @param keep_all Keep all column of `db` or keep only columns defined in `cols` #' -#' @return `Ginet` class object containing the description of diagram of the semi-distributed catchment model +#' @return `Griwrm` class object containing the description of diagram of the semi-distributed catchment model #' @export -Ginet <- function(db, cols = list(id = "id", down = "down", length = "length", runoff = "runoff"), keep_all = FALSE) { - colsDefault <- list(id = "id", down = "down", length = "length", runoff = "runoff") +Griwrm <- function(db, cols = list(id = "id", down = "down", length = "length", model = "model"), keep_all = FALSE) { + colsDefault <- list(id = "id", down = "down", length = "length", model = "model", area = "area") cols <- utils::modifyList(colsDefault, as.list(cols)) db <- dplyr::rename(db, unlist(cols)) if(!keep_all) { db <- dplyr::select(db, names(cols)) } - class(db) <- append(class(db), c("Griwrm", "Ginet")) + class(db) <- append(class(db), c("Griwrm", "Griwrm")) db } #' Sort the nodes from upstream to downstream. #' -#' @param ginet See \code{[Ginet]}. +#' @param griwrm See \code{[Griwrm]}. #' #' @return vector with the ordered node names. #' @export -getNodeRanking <- function(ginet) { - if(!is(ginet, "Ginet")) { - stop("getNodeRanking: ginet argument should be of class Ginet") +getNodeRanking <- function(griwrm) { + if(!is(griwrm, "Griwrm")) { + stop("getNodeRanking: griwrm argument should be of class Griwrm") } # Rank 1 - rank <- setdiff(ginet$id, ginet$down) + rank <- setdiff(griwrm$id, griwrm$down) ranking <- rank # Next ranks - while(any(ginet$id %in% rank)) { - rank <- ginet$down[ginet$id %in% rank] + while(any(griwrm$id %in% rank)) { + rank <- griwrm$down[griwrm$id %in% rank] ranking <- c(ranking, rank) } ranking <- unique(ranking, fromLast = TRUE) diff --git a/R/RunModel.GriwrmInputsModel.R b/R/RunModel.GriwrmInputsModel.R index 10813896e205425288f8d95fa102b9f72375863f..6b7e2894157f99b70793ce3fbbdb9072d2e973b7 100644 --- a/R/RunModel.GriwrmInputsModel.R +++ b/R/RunModel.GriwrmInputsModel.R @@ -2,13 +2,13 @@ #' #' @param InputsModel object of class \emph{GriwrmInputsModel}, see \code{[CreateInputsModel.Griwrm]} for details. #' @param RunOptions object of class \emph{GriwrmRunOptions}, see \code{[CreateRunOptions.Griwrm]} for details. -#' @param girop Girop object giving the run-off model parameters, see \code{[Girop]}. +#' @param Param list of parameter. The list item names are the IDs of the sub-basins. Each item is a vector of numerical parameters. #' @param verbose (optional) boolean indicating if the function is run in verbose mode or not, default = \code{TRUE} #' @param ... Mandatory for S3 method signature function compatibility with generic. #' #' @return \emph{GriwrmOutputsModel} object which is a list of \emph{OutputsModel} objects (See \code{\link[airGR]{RunModel}}) for each node of the semi-distributed model. #' @export -RunModel.GriwrmInputsModel <- function(InputsModel, RunOptions, girop, verbose = TRUE, ...) { +RunModel.GriwrmInputsModel <- function(InputsModel, RunOptions, Param, verbose = TRUE, ...) { OutputsModel <- list() class(OutputsModel) <- append(class(OutputsModel), "GriwrmOutputsModel") @@ -23,7 +23,7 @@ RunModel.GriwrmInputsModel <- function(InputsModel, RunOptions, girop, verbose = OutputsModel[[IM$id]] <- RunModel( InputsModel = IM, RunOptions = RunOptions[[IM$id]], - Param = unlist(girop$params[girop$id == IM$id]) + Param = Param[[IM$id]] ) } diff --git a/R/RunModel.InputsModel.R b/R/RunModel.InputsModel.R index 3b94045a3c66301260ec283d35909774804f208a..c4d2287bf07be41ce11f9db6032e5f8b4410f2b8 100644 --- a/R/RunModel.InputsModel.R +++ b/R/RunModel.InputsModel.R @@ -1,11 +1,6 @@ -#' Wrapper for \code{\link[airGR]{RunModel}} which performs a single model run with the provided function over the selected period. +#' Wrapper for \code{\link[airGR]{RunModel}} for one sub-basin. #' -#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details. -#' @param RunOptions object of class \emph{RunOptions}, see \code{\link[airGR]{CreateRunOptions}} for details. -#' @param Param numeric vector of model parameters. -#' @param FUN_MOD hydrological model function (e.g. \code{\link[airGR]{RunModel_GR4J}}, \code{\link[airGR]{RunModel_CemaNeigeGR4J}}). -#' -#' @return +#' @inherit airGR::RunModel #' @export RunModel.InputsModel <- function(InputsModel, RunOptions, Param, FUN_MOD = NULL, ...) { if(is.null(FUN_MOD)) { diff --git a/R/girop.R b/R/girop.R deleted file mode 100644 index 7225bdcde2eadcf5dee35b2c24e4481681dd7ce9..0000000000000000000000000000000000000000 --- a/R/girop.R +++ /dev/null @@ -1,22 +0,0 @@ -#' Generate the list of run-off models and their parameters -#' -#' @param db data frame containing at least the id the area and the model of the sub-basin. -#' @param cols named list or vector for matching columns of `db` parameter. By default, mandatory columns names are: `id`, `area`, `model`. But other names can be handled with a named list or vector containing items defined as `"required name" = "column name in db"`. -#' @param keep_all Keep all column of `db` or keep only columns defined in `cols` -#' -#' @return \emph{Girop} object. -#' @export -Girop <- function(db, cols = c(id = "id", area = "area", model = "model", params = "params"), keep_all = FALSE) { - colsDefault <- list(id = "id", area = "area", model = "model", params = "params") - cols <- utils::modifyList(colsDefault, as.list(cols)) - if(!any(names(db) == cols$params)) { - # Add missing params column in the database - db[[cols$params]] = NA - } - db <- dplyr::rename(db, unlist(cols)) - if(!keep_all) { - db <- dplyr::select(db, names(cols)) - } - class(db) <- append(class(db), "Girop") - db -} diff --git a/R/gits.R b/R/gits.R deleted file mode 100644 index 929fbc38b2e52eb1b3ba1eed7f891ca09e8f7e53..0000000000000000000000000000000000000000 --- a/R/gits.R +++ /dev/null @@ -1,46 +0,0 @@ -#' Title -#' -#' @param id string of the id of the node -#' @param ts numeric matrix or data frame containing 3 columns for precipitation, evaporation, and observed flow -#' @param cols named list or vector used for matching the columns of ts with the required columns names which are "Precip", "PotEvap", and "Qobs". -#' -#' @return \emph{Gits} class object which is a list containing a `date` element (Vector of PosiXlt timestamps) and an element named the id of the node containing a dataframe with observed data. -#' @export -Gits <- function(id, ts, - cols = list(date = "date", Precip = "Precip", PotEvap = "PotEvap", Qobs = "Qobs")) { - - cols <- as.list(cols) - ts <- dplyr::rename(ts, unlist(cols)) - - if(any(is.na(ts$Qobs))) { - stop("Qobs should not contain any NA") - } - if(any(ts$Qobs < 0)) { - stop("Qobs should be strictly positive") - } - - gitsOut <- list(date = ts$date) - cols$date <- NULL - gitsOut[[id]] <- dplyr::select(ts, names(cols)) - class(gitsOut) <- append(class(gitsOut), "Gits") - gitsOut -} - -#' Merge two gits objects with identical date time series. -#' -#' @param x Gits object to merge (See [Gits]). -#' @param y Gits object to merge (See [Gits]). -#' @param ... For merge generic function compatibility. -#' -#' @return Gits object merged with one item `Date` and Items corresponding to each node. -#' @export -merge.Gits <- function(x, y, ...) { - if(!is(y, "Gits")) { - stop("A Gits class object can only be merged with a Gits class object") - } - if(! identical(x$date, y$date)) { - stop("Time series dates are not identical") - } - y$date <- NULL - x <- utils::modifyList(x, y) -} diff --git a/inst/seine_data/network_gauging_stations.txt b/inst/seine_data/network_gauging_stations.txt new file mode 100644 index 0000000000000000000000000000000000000000..83e76b49a61b27f4f2bdef23067613c659dacdb8 --- /dev/null +++ b/inst/seine_data/network_gauging_stations.txt @@ -0,0 +1,26 @@ +id_sgl id_hydro lambert2.x lambert2.y area description id_aval distance_aval +TRANN_01 766626.06 2369152.25 1557.06 l'Aube à Trannes ARCIS_24 68100 +GURGY_02 H2221010 689713.00 2320549.00 3819.77 L'Yonne à Gurgy COURL_23 83612 +BRIEN_03 H2482010 695313.00 2332549.00 2979.77 L'Armançon à Brienon-sur-Armançon COURL_23 84653 +STDIZ_04 H5071010 791113.00 2407349.00 2347.53 La Marne à Saint-Dizier CHALO_21 85570 +PARIS_05 H5920010 602213.00 2427449.00 43824.66 La Seine à Paris +BAR-S_06 H0400010 751913.00 2348349.00 2340.37 La Seine à Bar-sur-Seine MERY-_22 79766 +CHAUM_07 716518.38 2241747.00 216.50 L'Yonne à Chaumard GURGY_02 153074 +CUSSY_08 H2172310 726013.00 2275149.00 247.99 Le Cousin à Cussy-les-Forges GURGY_02 91378 +STGER_09 718512.88 2266649.25 402.74 La Cure à St-Germain GURGY_02 94152 +GUILL_10 H2322020 731013.00 2282349.00 488.71 Le Serein à Guillon CHABL_12 66026 +AISY-_11 H2452020 742413.00 2298149.00 1349.51 L'Armançon à Aisy-sur-Armançon BRIEN_03 102428 +CHABL_12 H2342010 709613.00 2314149.00 1116.27 Le Serein à Chablis COURL_23 111781 +NOGEN_13 685912.88 2389349.25 9182.39 La Seine à Nogent-sur-Seine MONTE_15 63215 +EPISY_14 H3621010 633413.00 2371049.00 3916.71 Le Loing à Épisy ALFOR_16 89196 +MONTE_15 645112.88 2376849.25 21199.39 La Seine à Montereau ALFOR_16 94475 +ALFOR_16 H4340020 606013.00 2420349.00 30784.71 La Seine à Alfortville PARIS_05 9263 +NOISI_17 H5841010 620913.00 2428949.00 12547.72 La Marne à Noisiel PARIS_05 39384 +MONTR_18 H5752020 638013.00 2431849.00 1184.81 Le Grand Morin à Montry NOISI_17 37915 +LOUVE_19 H5083050 791613.00 2393949.00 461.74 La Blaise à Louvemont CHALO_21 86165 +LASSI_20 H1362010 759513.00 2385549.00 876.53 La Voire à Lassicourt ARCIS_24 43618 +CHALO_21 H5201010 747713.00 2441349.00 6291.55 La Marne à Châlons-sur-Marne NOISI_17 237937 +MERY-_22 H0810010 714913.00 2390949.00 3899.62 La Seine à Méry-sur-Seine NOGEN_13 49933 +COURL_23 H2721010 660813.00 2370449.00 10687.35 L'Yonne à Courlon-sur-Yonne MONTE_15 26159 +ARCIS_24 H1501010 733313.00 2394749.00 3594.60 L'Aube à Arcis-sur-Aube NOGEN_13 70926 +VITRY_25 H5172010 768513.00 2418849.00 2109.14 La Saulx à Vitry-en-Perthois CHALO_21 38047 diff --git a/vignettes/V01_First_network.Rmd b/vignettes/V01_First_network.Rmd index f834388dfa8a949ef07cbc104ed7faedb4e1cde4..a14ce2fb5512e0ddfb666aa0889dc17b929dbba1 100644 --- a/vignettes/V01_First_network.Rmd +++ b/vignettes/V01_First_network.Rmd @@ -22,106 +22,86 @@ List of nodes ```{r} seine_nodes <- readr::read_delim( - file = "https://stratus.irstea.fr/d/0b18e688851a45478f7a/files/?p=/climaware_hydro/griwrm_network.txt&dl=1", - delim = ";" + file = system.file("seine_data", "network_gauging_stations.txt", package = "griwrm"), + delim = "\t" ) seine_nodes ``` -Create the ginet object which lists the nodes and describes the network diagram. It's a dataframe of class `Ginet` and `Griwrm` with specific column names: +Create the griwrm object which lists the nodes and describes the network diagram. It's a dataframe of class `Griwrm` and `Griwrm` with specific column names: -- `id`: the identifier of the node in the network -- `down`: the identifier of the next node downstream -- `length`: hydraulic distance to the next downstream node -- `runoff`: does the node is a rainfall run-off model? +- `id`: the identifier of the node in the network. +- `down`: the identifier of the next hydrological node downstream. +- `length`: hydraulic distance to the next hydrological downstream node. +- `model`: Name of the hydrological model used (E.g. "RunModel_GR4J"). `NA` for other type of node. +- `area`: Area of the sub-catchment (km<sup>2</sup>). Used for hydrological model such as GR models. `NA` if not used. -`Ginet` function helps to rename the columns of the dataframe and assign the variable classes. +`Griwrm` function helps to rename the columns of the dataframe and assign the variable classes. ```{r} -# Specify that all nodes are of run-off type -seine_nodes$runoff <- TRUE -# Convert distance in km as it the unit used by airGR -seine_nodes$length <- seine_nodes$distance_aval / 1000 -# Generate the ginet object -ginet <- Ginet(seine_nodes, list(id = "id_sgl", down = "id_aval")) -ginet +seine_nodes$model <- "RunModel_GR4J" +# Generate the griwrm object +griwrm <- Griwrm(seine_nodes, list(id = "id_sgl", down = "id_aval", length = "distance_aval")) +griwrm ``` -Each line of the `Ginet` object having the `runoff` columns switched to `TRUE` should have a corresponding line in the `Girop` object which contains the parameters of the rainfall run-off models. -The `Girop` object is a dataframe of class `Girop` with specific columns: +## Observation time series -- `id`: the identifier of the node in the network -- `area`: the total area of the basin (including upstream sub-basins) at the location of the node (km<sup>2</sup>) -- `model`: the name of the rainfall run-off model used (e.g. "RunModel_GR4J") -- `params`: a list containing the calibration parameters of the model +Loading hydrometeorological data on the Seine river basin from the ClimAware project: -```{r} -# Specify which run-off model to use -seine_nodes$model = "RunModel_GR4J" -# Generate girop object -girop <- Girop(seine_nodes, list(id = "id_sgl", area = "area")) -girop -``` - - -## Observation time series +```{r, warning=FALSE, message=FALSE} -Loading hydrometeorological data on the Seine river basin from the ClimAware project: +Precip <- NULL +PotEvap <- NULL +Qobs <- NULL -```{r, warning=FALSE, message=FALSE} -urls <- - file.path( - "https://stratus.irstea.fr/d/0b18e688851a45478f7a/files/?p=/climaware_hydro/Q_OBS_NAT", - paste0(ginet$id, "_NAT.txt&dl=1") - ) -names(urls) <- ginet$id - -load_ts <- function(x) { - ts <- readr::read_delim(file = x, - delim = ";", skip = 16, trim_ws = TRUE) - ts$Date <- as.POSIXlt(lubridate::ymd(ts$Date)) - # Interpolation of data gap in the discharge time serie - ts[ts$Qnat < 0, "Qnat"] <- NA - if(is.na(ts$Qnat[nrow(ts)])) { - ts$Qnat[nrow(ts)] <- 0 # No value at the end: time serie converge to zero +MergeTS <- function(dfOld, id, dfNew) { + names(dfNew) <- c("DatesR", id) # Renaming columns of the new input into date and sub-basin ID + if(is.null(dfOld)) { + dfOut <- dfNew # Creation of the first column + } else { + dfOut <- merge(dfOld, dfNew, by = "DatesR", all = TRUE) # Merge the new columns respecting to date column } - ts$Qnat <- zoo::na.approx(ts$Qnat) - ts + return(dfOut) } -l <- lapply(urls, load_ts) - -``` - -`Gits` object is a list containing a item named `date` with a timestamp vector of the time series and items named by the identifier of each node. These items contain a dataframe with the observations. - -The Gits function creates a `Gits` object - -```{r} -gits <- Gits(ginet$id[1], l[[ginet$id[1]]], cols = list(date = "Date", Precip = "Ptot", PotEvap = "ETP", Qobs = "Qnat")) -``` - -Copy the observations for each node the ginet network: - -```{r} -for(id in ginet$id) { - l[[id]]$Qnat - l[[id]]$Qnat <- l[[id]]$Qnat * 86.4 / girop$area[girop$id == id] - l[[id]]$Qnat[l[[id]]$Qnat < 0] <- NA - gits <- merge(gits, Gits(id, l[[id]], cols = list(date = "Date", Precip = "Ptot", PotEvap = "ETP", Qobs = "Qnat"))) +for(id in griwrm$id) { + url <- + file.path( + "https://stratus.irstea.fr/d/0b18e688851a45478f7a/files/?p=/climaware_hydro/Q_OBS_NAT", + paste0(id, "_NAT.txt&dl=1") + ) + ts <- readr::read_delim(file = url, + delim = ";", skip = 16, trim_ws = TRUE) + # Date conversion to POSIX + ts$Date <- as.POSIXlt(lubridate::ymd(ts$Date)) + # Ptot column is merged into Precip dataframe + Precip <- MergeTS(Precip, id, ts[,c("Date", "Ptot")]) + # ETP column is merged into PotEvap dataframe + PotEvap <- MergeTS(PotEvap, id, ts[,c("Date", "ETP")]) + # Convert Qobs from m3/s to mm/time step + ts$Qnat <- ts$Qnat * 86.4 / griwrm$area[griwrm$id == id] + # Setting data gaps to NA + ts$Qnat[ts$Qnat <= 0] <- NA + # Qnat column is merged into Qobs dataframe + Qobs <- MergeTS(Qobs, id, ts[,c("Date", "Qnat")]) } +DatesR <- Precip$DatesR +Precip$DateR <- NULL +PotEvap$DateR <- NULL +Qobs$DateR <- NULL ``` ## Generate the GRIWRM InputsModel object The GRIWRM InputsModel object is a list of airGR InputsModel. The identifier of the sub-basin is used as key in the list which is ordered from upstream to downstream. -The airGR CreateInputsModel function is extended in order to handle the ginet object which describe the basin diagram: +The airGR CreateInputsModel function is extended in order to handle the griwrm object which describe the basin diagram: ```{r} -InputsModel <- CreateInputsModel(ginet, girop, gits) +InputsModel <- CreateInputsModel(griwrm, DatesR, Precip, PotEvap, Qobs) ``` @@ -129,7 +109,8 @@ InputsModel <- CreateInputsModel(ginet, girop, gits) ## Save data for next vignettes ```{r} + dir.create("_cache", showWarnings = FALSE) -save(ginet, girop, gits, InputsModel, file = "_cache/V01.RData") +save(griwrm, Qobs, InputsModel, file = "_cache/V01.RData") ``` diff --git a/vignettes/V03_First_Calibration.Rmd b/vignettes/V03_First_Calibration.Rmd index d31b28e54fe1aee2c03c09e03f8ba34a80782f20..276f432e859c52327943f163bbbadf5e367c3093 100644 --- a/vignettes/V03_First_Calibration.Rmd +++ b/vignettes/V03_First_Calibration.Rmd @@ -25,9 +25,9 @@ load("_cache/V02.RData") ```{r} InputsCrit <- CreateInputsCrit( - InputsModel = InputsModel, + InputsModel = InputsModel, FUN_CRIT = airGR::ErrorCrit_KGE2, - RunOptions = RunOptions, gits = gits + RunOptions = RunOptions, Qobs = Qobs ) str(InputsCrit) ``` @@ -53,25 +53,29 @@ save(OutputsCalib, file = "_cache/V03.RData") ## Run model with Michel calibration ```{r} -giropMichel <- girop -for(id in giropMichel$id) { - giropMichel$params[giropMichel$id == id] <- list(OutputsCalib[[id]]$Param) -} +ParamMichel <- sapply(griwrm$id, function(x) {OutputsCalib[[x]]$Param}) OutputsModels <- RunModel( InputsModel = InputsModel, RunOptions = RunOptions, - girop = giropMichel + Param = ParamMichel ) ``` +## Save calibration data for next vignettes + +```{r} +save(ParamMichel, file = "_cache/V03.RData") +``` + + ## Plot the result for each basin ```{r, fig.height = 5, fig.width = 8} htmltools::tagList(lapply( - names(OutputsModels), + names(OutputsModels), function(x) { - plot(OutputsModels[[x]], Qobs = gits[[x]]$Qobs[RunOptions[[x]]$IndPeriod_Run] , main = x) + plot(OutputsModels[[x]], Qobs = Qobs[RunOptions[[x]]$IndPeriod_Run,x] , main = x) } )) ``` diff --git a/vignettes/v02_First_run.Rmd b/vignettes/v02_First_run.Rmd index 67ca6f03cfbfd7795051b7cce3ca43853744da5a..91712d0e7277e187215a32879f849446676c7a20 100644 --- a/vignettes/v02_First_run.Rmd +++ b/vignettes/v02_First_run.Rmd @@ -28,7 +28,7 @@ Run `vignette("01_First_network", package = "griwrm")` before this one in order load("_cache/V01.RData") ``` -### Loading +### Loading Data comes from calibration of ClimAware project with naturalised flows. @@ -40,29 +40,31 @@ ClimAwareParams <- readr::read_csv( ClimAwareParams ``` -The lag $\tau_0$ and route $K_0$ parameters of TGR are expressed as time delay in hours corresponding to the delay time between the farest upstream inlet and the outlet of the sub-basin. +The lag $\tau_0$ and route $K_0$ parameters of TGR are expressed as time delay in hours corresponding to the delay time between the farest upstream inlet and the outlet of the sub-basin. Almost all sub basin has only a lag parameter. The only exception is for La Marne à Noisiel (NOISI_17) that has a routing parameter which can be approximated to a single lag parameter equals to $\tau_0 + K_0$. This lag parameter has to be converted in a speed in m/s used in the airGR lag model: ```{r} # Convert TGR routing parameter into speed -params <- merge(ginet, ClimAwareParams, by.x = "id", by.y = "id_sgl") - -for(id in girop$id) { - # Maximum connection length with upstream nodes - UpstrNodes <- which(ginet$down == id & !is.na(ginet$down)) +params <- merge(griwrm, ClimAwareParams, by.x = "id", by.y = "id_sgl") + +ParamClimAware <- sapply(griwrm$id, function(id) { + nodeParam <- ClimAwareParams[ClimAwareParams$id_sgl == id,] + # Record hydrological model parameters + Param <- unlist(nodeParam[c("S", "IGF", "KR", "T")]) + # Add lag model parameter if upstream nodes exist + UpstrNodes <- which(griwrm$down == id & !is.na(griwrm$down)) if(length(UpstrNodes) > 0) { - maxLength <- max(ginet$length[UpstrNodes]) - params$LAG <- maxLength * 1000 / ((params$Tau0 + params$K0) * 3600) - sLag <- "LAG" - } else { - sLag <- NULL + maxLength <- max(griwrm$length[UpstrNodes]) + Param <- c( + Param, + maxLength / ((nodeParam$Tau0 + nodeParam$K0) * 3600) + ) } - girop$params[girop$id == id] <- list(params[params$id == id, c("S", "IGF", "KR", "T", sLag)]) -} + return(Param) +}) -dplyr::select(params, id, S, IGF, KR, T, LAG) ``` ## GriwmRunOptions object @@ -80,7 +82,7 @@ library(lubridate) IndPeriod_Run <- seq( which(InputsModel[[1]]$DatesR == (InputsModel[[1]]$DatesR[1] + months(12))), # Set aside warm-up period length(InputsModel[[1]]$DatesR) # Until the end of the time series -) +) ``` The warmup period could also be defined as is: @@ -93,8 +95,8 @@ IndPeriod_WarmUp = seq(1,IndPeriod_Run[1]-1) ```{r} RunOptions <- CreateRunOptions( - InputsModel = InputsModel, - IndPeriod_WarmUp = IndPeriod_WarmUp, + InputsModel = InputsModel, + IndPeriod_WarmUp = IndPeriod_WarmUp, IndPeriod_Run = IndPeriod_Run ) ``` @@ -107,23 +109,23 @@ RunOptions <- CreateRunOptions( OutputsModelsClimAware <- RunModel( InputsModel = InputsModel, RunOptions = RunOptions, - girop + Param = ParamClimAware ) ``` ## Save data for next vignettes ```{r} -save(RunOptions, file = "_cache/V02.RData") +save(RunOptions, ParamClimAware, file = "_cache/V02.RData") ``` ## Plot the result for each basin ```{r, fig.height = 5, fig.width = 8} htmltools::tagList(lapply( - names(OutputsModelsClimAware), + names(OutputsModelsClimAware), function(x) { - plot(OutputsModelsClimAware[[x]], Qobs = gits[[x]]$Qobs[IndPeriod_Run] , main = x) + plot(OutputsModelsClimAware[[x]], Qobs = Qobs[IndPeriod_Run,x] , main = x) } )) ```