Commit 7eab11ae authored by Dorchies David's avatar Dorchies David
Browse files

feat(RunModel.Supervisor): handle initial conditions

Refs #48
parent 730e9909
Pipeline #24876 passed with stage
in 6 minutes and 17 seconds
......@@ -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]],
......
......@@ -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)
}
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment