Forked from HYCAR-Hydro / airGR
Source project has a limited visibility.
test-RunModel_Lag.R 11.08 KiB
context("RunModel_Lag")
data(L0123001)
test_that("'BasinAreas' must have one more element than 'LengthHydro'", {
  expect_error(
    InputsModel <- CreateInputsModel(
      FUN_MOD = RunModel_GR4J,
      DatesR = BasinObs$DatesR,
      Precip = BasinObs$P,
      PotEvap = BasinObs$E,
      Qupstream = matrix(BasinObs$Qmm, ncol = 1),
      LengthHydro = 1,
      BasinAreas = 1
    regexp = "'BasinAreas' must have one more element than 'LengthHydro'"
BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea)
# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
Qupstream <- floor((sin((seq_along(BasinObs$Qmm)/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE))
InputsModel <- CreateInputsModel(
  FUN_MOD = RunModel_GR4J,
  DatesR = BasinObs$DatesR,
  Precip = BasinObs$P,
  PotEvap = BasinObs$E,
  Qupstream = matrix(Qupstream, ncol = 1),
  LengthHydro = 1,
  BasinAreas = BasinAreas
Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
               which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
                                                InputsModel = InputsModel,
                                                IndPeriod_Run = Ind_Run))
test_that("QcontribDown parameter should be a numeric vector or an OutputModel object", {
  regexp = "'QcontribDown' must be a numeric vector or a 'OutputsModel' object"
  expect_error(
    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = "A"),
    regexp = regexp
  expect_error(
    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = NULL),
    regexp = regexp
  expect_error(
    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = matrix(1, ncol = 1)),
    regexp = regexp
Param <- c(257.237556, 1.012237, 88.234673, 2.207958) #  From vignettes/V01_get_started
OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel,
                                 RunOptions = RunOptions,
                                 Param = Param)
test_that("QcontribDown should contain a Qsim key", {
  QcontribDown <- OutputsGR4JOnly
  QcontribDown$Qsim <- NULL
  expect_error(
    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
    regexp = "should contain a key 'Qsim'"
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
}) test_that("'QcontribDown$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", { QcontribDown <- OutputsGR4JOnly QcontribDown$Qsim <- c(QcontribDown$Qsim, 0) expect_error( RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown), regexp = "should have the same lenght as" ) }) test_that("RunModel(FUN=RunModel_Lag) should give same result as RunModel_Lag", { QcontribDown <- OutputsGR4JOnly Output_RunModel_Lag <- RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown) Output_RunModel <- RunModel(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, FUN_MOD = RunModel_Lag, QcontribDown = QcontribDown) expect_equal(Output_RunModel, Output_RunModel_Lag) }) test_that("'Qupstream' contain NA values", { expect_warning( InputsModel <- CreateInputsModel( FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, Precip = BasinObs$P, PotEvap = BasinObs$E, Qupstream = matrix(BasinObs$Qmm, ncol = 1), LengthHydro = 1, BasinAreas = BasinAreas ), regexp = "'Qupstream' contains NA values: model outputs will contain NAs" ) RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel, IndPeriod_Run = Ind_Run)) QcontribDown <- OutputsGR4JOnly # Warning with RunModel_Lag expect_warning( RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown), regexp = "time steps with NA values" ) # No warning during calibration RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal expect_warning( RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown), regexp = NA ) }) test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { UpstBasinArea <- InputsModel$BasinAreas[1L] InputsModel$BasinAreas[1L] <- 0 OutputsSD <- RunModel(InputsModel, RunOptions, Param = c(1, Param), FUN_MOD = RunModel_GR4J) expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim) }) test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", { InputsModel$LengthHydro <- 0 InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0) OutputsSD <- RunModel(InputsModel,