tests/testthat/test-CreateInputsCrit.R

In inrae/airGRiwrm: 'airGR' Integrated Water Resource Management

test_that("airGR::CreateInputsCrit should works", {
  ## loading catchment data
  data(L0123001)

  ## preparation of InputsModel object
  InputsModel <- CreateInputsModel(RunModel_GR4J, DatesR = BasinObs$DatesR,
                                   Precip = BasinObs$P, PotEvap = BasinObs$E)

  ## calibration period selection
  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"))
  Ind_WarmUp <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1989-01-01"),
                    which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1989-12-31"))

  ## preparation of RunOptions object
  RunOptions <- CreateRunOptions(RunModel_GR4J,
                                 InputsModel = InputsModel,
                                 IndPeriod_Run = Ind_Run,
                                 IndPeriod_WarmUp = Ind_WarmUp)

  ## calibration criterion: preparation of the InputsCrit object
  InputsCrit <- airGR::CreateInputsCrit(ErrorCrit_NSE, InputsModel = InputsModel,
                                 RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run])
  expect_equal(CreateInputsCrit(ErrorCrit_NSE, InputsModel = InputsModel,
                                RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run]),
               InputsCrit)
  expect_equal(CreateInputsCrit("ErrorCrit_NSE", InputsModel = InputsModel,
                                RunOptions = RunOptions, Obs = BasinObs$Qmm[Ind_Run]),
               InputsCrit)
})

# data set up
e <- setupRunModel()
# variables are copied from environment 'e' to the current environment
# https://stackoverflow.com/questions/9965577/r-copy-move-one-environment-to-another
for(x in ls(e)) assign(x, get(x, e))
rm(e)

context("CreateInputsCrit.GRiwrmInputsModel")

test_that("Wrong argument class should throw error", {
  expect_error(CreateInputsCrit(InputsModel = InputsModel[[1]],
                                RunOptions = RunOptions,
                                Obs = Qobs[IndPeriod_Run,]))
  expect_error(CreateInputsCrit.GRiwrmInputsModel(InputsModel = InputsModel[[1]],
                                RunOptions = RunOptions,
                                Obs = Qobs[IndPeriod_Run,]),
               regexp = "GRiwrmInputsModel")

  expect_error(CreateInputsCrit(InputsModel = InputsModel,
                                RunOptions = RunOptions[[1]],
                                Obs = Qobs[IndPeriod_Run,]),
               regexp = "GRiwrmRunOptions")
  expect_error(CreateInputsCrit(InputsModel = InputsModel,
                                RunOptions = RunOptions,
                                Obs = 1),
               regexp = "matrix or data.frame")
})

test_that("Using Lavenne criterion with 'weight' should throw error", {
  expect_error(
    CreateInputsCrit(InputsModel = InputsModel,
                     RunOptions = RunOptions,
                     Obs = Qobs[IndPeriod_Run,],
                     AprioriIds = c("54057" = "54032", "54032" = "54001", "54001" = "54095"),
                     Weights = c(0.85)),
    regexp = "Lavenne"
  )
})

test_that("Lavenne criterion without defining `transfo` should throw error", {
  expect_error(CreateInputsCrit(InputsModel = InputsModel,
                                      RunOptions = RunOptions,
                                      Obs = Qobs[IndPeriod_Run,],
                                      AprioriIds = c("54057" = "54032")),
               regexp = "transfo")
})

AprioriIds <- c("54057" = "54032", "54032" = "54001", "54001" = "54095")
IC <- CreateInputsCrit(InputsModel = InputsModel,
                       RunOptions = RunOptions,
                       Obs = Qobs[IndPeriod_Run,],
                       AprioriIds = AprioriIds,
                       transfo = "sqrt")

test_that("Lavenne criterion is OK", {
  expect_s3_class(IC[["54057"]], "InputsCritLavenneFunction")
  Lavenne_FUN <- attr(IC[["54057"]], "Lavenne_FUN")
  IC57 <- Lavenne_FUN(ParamMichel[["54032"]], 0.9)
  expect_s3_class(IC57, "InputsCrit")
  expect_s3_class(IC57, "Compo")
})

test_that("Lavenne embedded data is correct #57", {
  lapply(names(AprioriIds), function(id) {
    p <- as.list(environment(attr(IC[[id]], "Lavenne_FUN")))
    expect_equal(id, p$InputsModel$id)
  })
})

test_that("Lavenne criterion: wrong sub-catchment order should throw error", {
  expect_error(
    CreateInputsCrit(InputsModel = InputsModel,
                     RunOptions = RunOptions,
                     Obs = Qobs[IndPeriod_Run,],
                     AprioriIds = c("54057" = "54032", "54032" = "54001", "54095" = "54029"),
                     transfo = "sqrt"),
    regexp = "is not calibrated before the node"
  )
})

test_that("Lavenne criterion: not upstream a priori nodes are allow if processed before #156", {
  IC156 <- CreateInputsCrit(
    InputsModel = InputsModel,
    RunOptions = RunOptions,
    Obs = Qobs[IndPeriod_Run, ],
    AprioriIds = c(
      "54057" = "54032",
      "54032" = "54001",
      "54029" = "54095"
    ),
    transfo = "sqrt"
  )
  expect_equal(attr(IC156$`54029`, "AprioriId"), c("54029" = "54095"))
  e <- runCalibration(
    nodes = nodes,
    Qinf = NULL,
    InputsCrit = IC156,
    CalibOptions = NULL,
    FUN_CRIT = ErrorCrit_KGE2,
    runRunModel = FALSE,
    IsHyst = FALSE
  )
  for (x in ls(e)) assign(x, get(x, e))
  # 54029 not processed as ungauged
  expect_false(is.null(OutputsCalib$`54029`$CritFinal))
})

test_that("Lavenne criterion: redefined calibration order works #157", {
  nodes$donor <- nodes$id
  nodes$donor[nodes$id == "54095"] <- "54029"
  e <- setupRunModel(runRunModel = FALSE,
                          griwrm = CreateGRiwrm(nodes))
  for (x in ls(e)) assign(x, get(x, e))
  IC157 <- CreateInputsCrit(
    InputsModel = InputsModel,
    RunOptions = RunOptions,
    Obs = Qobs[IndPeriod_Run, ],
    AprioriIds = c(
      "54057" = "54032",
      "54032" = "54001",
      "54095" = "54029"
    ),
    transfo = "sqrt"
  )
  e <- runCalibration(
    nodes = nodes,
    Qinf = NULL,
    InputsCrit = IC157,
    CalibOptions = NULL,
    FUN_CRIT = ErrorCrit_KGE2,
    runRunModel = FALSE,
    IsHyst = FALSE
  )
  for (x in ls(e)) assign(x, get(x, e))
  expect_false(is.null(OutputsCalib$`54095`$CritFinal))
})

test_that("Lavenne criterion: current node and a priori node must use the same model", {
  InputsModel[["54032"]]$FUN_MOD <- RunModel_GR6J
  expect_error(
    CreateInputsCrit(InputsModel = InputsModel,
                     RunOptions = RunOptions,
                     Obs = Qobs[IndPeriod_Run,],
                     AprioriIds = AprioriIds,
                     transfo = "sqrt"),
    regexp = "must use the same hydrological model"
  )
})

test_that("Ungauged node as Apriori node should throw an error", {
  nodes$model[nodes$id == "54001"] <- "Ungauged"
  griwrm <- CreateGRiwrm(nodes)
  InputsModel <- CreateInputsModel(griwrm, DatesR, Precip, PotEvap)
  expect_error(
    CreateInputsCrit(InputsModel = InputsModel,
                     RunOptions = RunOptions,
                     Obs = Qobs[IndPeriod_Run,],
                     AprioriIds = c("54057" = "54032", "54032" = "54001", "54001" = "54029"),
                     transfo = "sqrt"),
    regexp = "\"54001\" is ungauged"
  )
})