tests/testthat/test-RunModel.Supervisor.R

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

skip_on_cran()

# 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))

# Add 2 nodes to the network
nodes2 <- rbind(nodes,
                data.frame(
                  id = c("R1", "R2"),
                  down = "54057",
                  length = 100,
                  area = NA,
                  model = NA
                ))
griwrm2 <- CreateGRiwrm(nodes2)

# Add Qinf for the 2 new nodes and create InputsModel
Qinf <- matrix(data = rep(0, 2*length(DatesR)), ncol = 2)
colnames(Qinf) <- c("R1", "R2")
InputsModel <-
  CreateInputsModel(griwrm2, DatesR, Precip, PotEvap, Qinf)

test_that("RunModel.Supervisor with two regulations that cancel each other out should returns same results as RunModel.GRiwrmInputsModel", {
  # Create Supervisor
  sv <- CreateSupervisor(InputsModel)
  # Function to withdraw half of the measured flow
  fWithdrawal <- function(y) { -y/2 }
  # Function to release half of the the measured flow
  fRelease <- function(y) { y/2 }
  # Controller that withdraw half of the flow measured at node "54002" at location "R1"
  CreateController(sv, "Withdrawal", Y = c("54002"), U = c("R1"), FUN = fWithdrawal)
  # Controller that release half of the flow measured at node "54002" at location "R2"
  CreateController(sv, "Release", Y = c("54002"), U = c("R2"), FUN = fRelease)

  OM_Supervisor <- RunModel(
    sv,
    RunOptions = RunOptions,
    Param = ParamMichel
  )
  expect_equal(OM_Supervisor[["54057"]]$Qsim, OM_GriwrmInputs[["54057"]]$Qsim)
})

test_that("RunModel.Supervisor with multi time steps controller, two regulations
          in 1 centralised controller that cancel each other out should returns
          same results as RunModel.GRiwrmInputsModel", {
  sv <- CreateSupervisor(InputsModel, TimeStep = 10L)
  fEverything <- function(y) {
    m <- matrix(c(y[,1]/2, -y[,1]/2), ncol = 2)
  }
  CreateController(sv, "Everything", Y = c("54002", "54032"), U = c("R1", "R2"), FUN = fEverything)
  OM_Supervisor <- RunModel(
    sv,
    RunOptions = RunOptions,
    Param = ParamMichel
  )
  expect_equal(OM_Supervisor[["54057"]]$Qsim, OM_GriwrmInputs[["54057"]]$Qsim)
})

test_that("RunModel.Supervisor with NA values in Qupstream", {
  # Create Supervisor
  InputsModel$`54057`$Qupstream[, c("R1", "R2")] <- NA
  sv <- CreateSupervisor(InputsModel)
  # Function to withdraw half of the measured flow
  fWithdrawal <- function(y) { -y/2 }
  # Function to release half of the the measured flow
  fRelease <- function(y) { y/2 }
  # Controller that withdraw half of the flow measured at node "54002" at location "R1"
  CreateController(sv, "Withdrawal", Y = c("54002"), U = c("R1"), FUN = fWithdrawal)
  # Controller that release half of the flow measured at node "54002" at location "R2"
  CreateController(sv, "Release", Y = c("54002"), U = c("R2"), FUN = fRelease)

  OM_Supervisor <- RunModel(
    sv,
    RunOptions = RunOptions,
    Param = ParamMichel
  )
  expect_equal(OM_Supervisor[["54057"]]$Qsim[1:3], rep(as.double(NA),3))
  expect_equal(OM_Supervisor[["54057"]]$Qsim[4:length(IndPeriod_Run)],
               OM_GriwrmInputs[["54057"]]$Qsim[4:length(IndPeriod_Run)])
})

test_that("RunModel.Supervisor with diversion node should not produce NAs", {
  nodes_div <- nodes
  nodes_div <- rbind(nodes_div, data.frame(id = "54001",
                                           down = "54029",
                                           length = 25,
                                           model = "Diversion",
                                           area = NA))
  nodes_div <- nodes_div[order(nodes_div$model), ]
  g_div <- CreateGRiwrm(nodes_div)
  Qinf <- matrix(data = rep(0, length(DatesR)), ncol = 1)
  colnames(Qinf) <- "54001"
  e <- setupRunModel(griwrm = g_div, runRunModel = FALSE, Qinf = Qinf)
  for (x in ls(e)) assign(x, get(x, e))
  sv <- CreateSupervisor(InputsModel, TimeStep = 1L)
  logicFunFactory <- function(sv) {
    #' @param Y Flow measured at "54002" the previous time step
    function(Y) {
      Qnat <- Y
      #  We need to remove the diverted flow to compute the natural flow at "54002"
      lastU <- sv$controllers[[sv$controller.id]]$U
      if (length(lastU) > 0) {
        Qnat <- max(0, Y + lastU)
      }
      return(-max(5.3 * 86400 - Qnat, 0))
    }
  }
  CreateController(sv,
                   ctrl.id = "Low flow support",
                   Y = "54029",
                   U = "54001",
                   FUN = logicFunFactory(sv))
  ParamMichel$`54029` <- c(1, ParamMichel$`54029`)
  OM_Supervisor <- RunModel(
    sv,
    RunOptions = RunOptions,
    Param = ParamMichel
  )
  expect_true(all(OM_Supervisor$`54001`$Qdiv_m3 >= 0))
  lapply(OM_Supervisor, function(OM) {
    expect_false(any(is.na(OM$Qsim)))
    expect_false(any(is.na(OM$Qsim_m3)))
  })
})