Skip to content
GitLab
Select Git revision
  • 181-simulation-water-losses-on-routed-flows-based-on-gr-groundwater-exchange-function
  • dev default
  • 183-createcaliboptions-crash-when-all-parameters-are-fixed
  • 180-write-a-vignette-with-exemple-of-use-of-runmodel-griwrmoutputsmodel
  • master
  • v0.7.0
  • v0.6.2
  • v0.6.1
  • v0.5.0
  • v0.4.0
  • v0.3.0
Find file BlameHistoryPermalink
test-RunModel.Supervisor.R 5.35 KiB
1 
skip_on_cran()
2
3 
# data set up
4 
e <- setupRunModel()
5 
# variables are copied from environment 'e' to the current environment
6 
# https://stackoverflow.com/questions/9965577/r-copy-move-one-environment-to-another
7 
for(x in ls(e)) assign(x, get(x, e))
8
9 
test_that("RunModel.Supervisor with no regulation should returns same results as RunModel.GRiwrmInputsModel", {
10 
  sv <- CreateSupervisor(InputsModel)
11 
  OM_Supervisor <- RunModel(
12 
    sv,
13 
    RunOptions = RunOptions,
14 
    Param = ParamMichel
15 
  )
16 
  lapply(griwrm$id, function(id) {
17 
    expect_equal(sort(names(OM_GriwrmInputs[[!!id]])),
18 
                 sort(names(OM_Supervisor[[!!id]])))
19 
    lapply(names(OM_Supervisor[[id]]), function(x) {
20 
      expect_equal(OM_Supervisor[[!!id]][[!!x]], OM_GriwrmInputs[[!!id]][[!!x]])
21 
    })
22 
  }) |> invisible()
23 
})
24
25 
# Add 2 nodes to the network
26 
nodes2 <- rbind(nodes,
27 
                data.frame(
28 
                  id = c("R1", "R2"),
29 
                  down = "54057",
30 
                  length = 100,
31 
                  area = NA,
32 
                  model = NA
33 
                ))
34 
griwrm2 <- CreateGRiwrm(nodes2)
35
36 
# Add Qinf for the 2 new nodes and create InputsModel
37 
Qinf <- matrix(data = rep(0, 2*length(DatesR)), ncol = 2)
38 
colnames(Qinf) <- c("R1", "R2")
39 
InputsModel <-
40 
  CreateInputsModel(griwrm2, DatesR, Precip, PotEvap, Qinf)
41
42 
test_that("RunModel.Supervisor with two regulations that cancel each other out should returns same results as RunModel.GRiwrmInputsModel", {
43 
  # Create Supervisor
44 
  sv <- CreateSupervisor(InputsModel)
45 
  # Function to withdraw half of the measured flow
46 
  fWithdrawal <- function(y) { -y/2 }
47 
  # Function to release half of the the measured flow
48 
  fRelease <- function(y) { y/2 }
49 
  # Controller that withdraw half of the flow measured at node "54002" at location "R1"
50 
  CreateController(sv, "Withdrawal", Y = c("54002"), U = c("R1"), FUN = fWithdrawal)
51 
  # Controller that release half of the flow measured at node "54002" at location "R2"
52 
  CreateController(sv, "Release", Y = c("54002"), U = c("R2"), FUN = fRelease)
53
54 
  OM_Supervisor <- RunModel(
55 
    sv,
56 
    RunOptions = RunOptions,
57 
    Param = ParamMichel
58 
  )
59 
  expect_equal(OM_Supervisor[["54057"]]$Qsim, OM_GriwrmInputs[["54057"]]$Qsim)
60 
})
61
62 
test_that("RunModel.Supervisor with multi time steps controller, two regulations
63 
          in 1 centralised controller that cancel each other out should returns
64 
          same results as RunModel.GRiwrmInputsModel", {
65 
  sv <- CreateSupervisor(InputsModel, TimeStep = 10L)
66 
  fEverything <- function(y) {
67 
    m <- matrix(c(y[,1]/2, -y[,1]/2), ncol = 2)
68 
  }
69 
  CreateController(sv, "Everything", Y = c("54002", "54032"), U = c("R1", "R2"), FUN = fEverything)
70 
  OM_Supervisor <- RunModel(
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
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)))
141142143144
expect_false(any(is.na(OM$Qsim_m3))) }) })