Forked from HYCAR-Hydro / airGR
Source project has a limited visibility.
test-RunModel_LAG.R 6.38 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)
test_that("'Qupstream' cannot contain any NA value", {
  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 = BasinAreas
    regexp = "'Qupstream' cannot contain any NA value"
# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
Qupstream = floor((sin((1:length(BasinObs$Qmm)/365*2*3.14))+1)*mean(BasinObs$Qmm, na.rm = T))
InputsModel <- CreateInputsModel(
  FUN_MOD = RunModel_GR4J,
  DatesR = BasinObs$DatesR,
  Precip = BasinObs$P,
  PotEvap = BasinObs$E,
  Qupstream = matrix(Qupstream, ncol = 1),
  LengthHydro = 1000,
  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 <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
                               InputsModel = InputsModel,
                               IndPeriod_Run = Ind_Run)
test_that("InputsModel parameter should contain an OutputsModel key", {
  expect_error(
    RunModel_LAG(InputsModel, RunOptions, 1), 
    regexp = "'InputsModel' should contain an 'OutputsModel' key"
Param = c(257.237556, 1.012237, 88.234673, 2.207958) #  From vignettes/V01_get_started
OutputsGR4JOnly <-
  RunModel_GR4J(InputsModel = InputsModel,
                RunOptions = RunOptions,
                Param = Param)
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
test_that("InputsModel$OutputsModel should contain a Qsim key", { InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel$Qsim <- NULL expect_error( RunModel_LAG(InputsModel, RunOptions, 1), regexp = "should contain a key 'Qsim'" ) }) test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", { InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0) expect_error( RunModel_LAG(InputsModel, RunOptions, 1), regexp = "should have the same lenght as" ) }) test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", { InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel$Qsim[10] <- NA expect_error( RunModel_LAG(InputsModel, RunOptions, 1), regexp = "contain no NA" ) }) test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { UpstBasinArea = InputsModel$BasinAreas[1] InputsModel$BasinAreas[1] <- 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, RunOptions, Param = c(1, Param), FUN_MOD = RunModel_GR4J) expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run]) } ) ParamSD = c(InputsModel$LengthHydro / (24 * 60 * 60), Param) # Speed corresponding to one time step delay QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2] * 1E6 / 86400 test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", { OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400 QlsUpstLagObs <- c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1] * 1E6 / 86400 expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) }) test_that("1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step", { OutputsSD <- RunModel(InputsModel, RunOptions, Param = c(InputsModel$LengthHydro / (12 * 3600), Param), FUN_MOD = RunModel_GR4J)