From 7eab11ae22bc9e5084b0c29775fc67f8cd6adb19 Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@inrae.fr>
Date: Mon, 12 Jul 2021 16:07:43 +0200
Subject: [PATCH] feat(RunModel.Supervisor): handle initial conditions

Refs #48
---
 R/RunModel.Supervisor.R        | 17 +++++++----------
 R/utils.R                      | 13 +++++++++++++
 tests/testthat/test-RunModel.R | 18 ++++++++++--------
 3 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/R/RunModel.Supervisor.R b/R/RunModel.Supervisor.R
index 1eb8cdc..f266ef0 100644
--- a/R/RunModel.Supervisor.R
+++ b/R/RunModel.Supervisor.R
@@ -43,16 +43,12 @@ RunModel.Supervisor <- function(x, RunOptions, Param, ...) {
   # Save Qsim for step by step simulation
   QcontribDown <- do.call(
     cbind,
-    lapply(x$OutputsModel, function(OM) {
-      OM$Qsim
-    })
+    lapply(x$OutputsModel, "[[", "Qsim")
   )
 
   Qsim_m3 <- do.call(
     cbind,
-    lapply(x$OutputsModel, function(OM) {
-      OM$Qsim_m3
-    })
+    lapply(x$OutputsModel, "[[", "Qsim_m3")
   )
 
   # Initialisation of model states by running the model with no supervision on warm-up period
@@ -62,16 +58,17 @@ RunModel.Supervisor <- function(x, RunOptions, Param, ...) {
     RunOptionsWarmUp[[id]]$IndPeriod_WarmUp <- 0L
     RunOptionsWarmUp[[id]]$Outputs_Sim <- c("StateEnd", "Qsim")
   }
-  x$OutputsModel <- suppressMessages(
+  OM_WarmUp <- suppressMessages(
     RunModel.GRiwrmInputsModel(x$InputsModel,
                                RunOptions = RunOptionsWarmUp,
                                Param = Param)
   )
 
-  # Adapt RunOptions to step by step simulation
+  # Adapt RunOptions to step by step simulation and copy states
   for(id in getSD_Ids(x$InputsModel)) {
     RunOptions[[id]]$IndPeriod_WarmUp <- 0L
-    RunOptions[[id]]$Outputs_Sim <- "StateEnd"
+    RunOptions[[id]]$Outputs_Sim <- c("Qsim_m3", "StateEnd")
+    x$OutputsModel[[id]]$StateEnd <- serializeIniStates(OM_WarmUp[[id]]$StateEnd)
   }
 
   # Loop over time steps with a step equal to the supervision time step
@@ -88,7 +85,7 @@ RunModel.Supervisor <- function(x, RunOptions, Param, ...) {
     for(id in getSD_Ids(x$InputsModel)) {
       # Run the SD model for the sub-basin and one time step
       RunOptions[[id]]$IndPeriod_Run <- iTS
-      RunOptions[[id]]$IniStates <- unlist(x$OutputsModel[[id]]$StateEnd)
+      RunOptions[[id]]$IniStates <- serializeIniStates(x$OutputsModel[[id]]$StateEnd)
       x$OutputsModel[[id]] <- RunModel.SD(
         x$InputsModel[[id]],
         RunOptions = RunOptions[[id]],
diff --git a/R/utils.R b/R/utils.R
index df1e119..6e08c9f 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -151,3 +151,16 @@ OutputsModelQsim <- function(InputsModel, OutputsModel, IndPeriod_Run) {
   class(dfQsim) <- c("Qm3s", class(dfQsim)) # For S3 methods
   return(dfQsim)
 }
+
+#' Convert IniStates list into a vector
+#'
+#' @param IniStates see [CreateIniStates]
+#'
+#' @return A vector as in `RunOptions$IniStates`
+#' @noRd
+#'
+serializeIniStates <- function(IniStates) {
+  IniStates <- unlist(IniStates)
+  IniStates[is.na(IniStates)] <- 0
+  return(IniStates)
+}
diff --git a/tests/testthat/test-RunModel.R b/tests/testthat/test-RunModel.R
index 258fed3..02fec88 100644
--- a/tests/testthat/test-RunModel.R
+++ b/tests/testthat/test-RunModel.R
@@ -38,7 +38,7 @@ IndPeriod_Run <- seq(
   length(InputsModel[[1]]$DatesR) - nTS + 1,
   length(InputsModel[[1]]$DatesR)
 )
-IndPeriod_WarmUp = seq(IndPeriod_Run[1]-366,IndPeriod_Run[1]-1)
+IndPeriod_WarmUp = seq(IndPeriod_Run[1]-365,IndPeriod_Run[1]-1)
 RunOptions <- CreateRunOptions(
   InputsModel = InputsModel,
   IndPeriod_WarmUp = IndPeriod_WarmUp,
@@ -68,18 +68,18 @@ test_that("RunModel.GRiwrmInputsModel should return same result with separated w
   RO_Run <- CreateRunOptions(
     InputsModel = InputsModel,
     IndPeriod_WarmUp = 0L,
-    IndPeriod_Run = IndPeriod_Run
+    IndPeriod_Run = IndPeriod_Run,
+    IniStates = lapply(OM_WarmUp, "[[", "StateEnd")
   )
-  for(id in names(RO_Run)) {
-    RO_Run[[id]]$IniResLevels <- NULL
-    RO_Run[[id]]$IniStates <- airGRiwrm:::serializeIniStates(OM_WarmUp[[id]]$StateEnd)
-  }
   OM_Run <- RunModel(
     InputsModel,
     RunOptions = RO_Run,
     Param = ParamMichel
   )
-  expect_equal(OM_GriwrmInputs[["54057"]]$Qsim, OM_Run[["54057"]]$Qsim)
+  lapply(griwrm$id, function(id) {
+    # The 2 exclamation marks are for seeing the id in the test result (See ?quasi_label)
+    expect_equal(OM_GriwrmInputs[[!!id]]$Qsim, OM_Run[[!!id]]$Qsim)
+  })
 })
 
 context("RunModel.Supervisor")
@@ -91,7 +91,9 @@ test_that("RunModel.Supervisor with no regulation should returns same results as
     RunOptions = RunOptions,
     Param = ParamMichel
   )
-  expect_equal(OM_Supervisor[["54057"]]$Qsim, OM_GriwrmInputs[["54057"]]$Qsim)
+  lapply(griwrm$id, function(id) {
+    expect_equal(OM_Supervisor[[!!id]]$Qsim, OM_GriwrmInputs[[!!id]]$Qsim)
+  })
 })
 
 # Add 2 nodes to the network
-- 
GitLab