From ede467bbd03eaf813b1ada977030fae9cbf0b703 Mon Sep 17 00:00:00 2001 From: Delaigue Olivier <olivier.delaigue@irstea.fr> Date: Mon, 18 Oct 2021 11:34:17 +0200 Subject: [PATCH] fix(Utils): manage WarmUpQsim and Param in .ExtractOutputsModel - return a RunOptions list from .GetOutputsModelGR (UtilsRunModel) with WarmUpQsim and Param, and remove the specific class of WarmUpQsim Refs #137 --- R/CreateErrorCrit_GAPX.R | 2 +- R/RunModel_Lag.R | 10 +++++----- R/Utils.R | 5 ++++- R/UtilsErrorCrit.R | 2 +- R/UtilsRunModel.R | 11 ++++++----- vignettes/V05_sd_model.Rmd | 2 +- 6 files changed, 18 insertions(+), 14 deletions(-) diff --git a/R/CreateErrorCrit_GAPX.R b/R/CreateErrorCrit_GAPX.R index 33b424fa..ac064ae9 100644 --- a/R/CreateErrorCrit_GAPX.R +++ b/R/CreateErrorCrit_GAPX.R @@ -6,7 +6,7 @@ CreateErrorCrit_GAPX <- function(FUN_TRANSFO) { stop("'OutputsModel' must be of class 'OutputsModel'") } - OutputsModel$ParamT <- FUN_TRANSFO(OutputsModel$Param, "RT") + OutputsModel$RunOptions$ParamT <- FUN_TRANSFO(OutputsModel$RunOptions$Param, "RT") EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "GAPX", OutputsModel = OutputsModel, warnings = warnings) diff --git a/R/RunModel_Lag.R b/R/RunModel_Lag.R index 63c99bcb..34ea35b6 100644 --- a/R/RunModel_Lag.R +++ b/R/RunModel_Lag.R @@ -48,10 +48,10 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) { if (inherits(QcontribDown, "OutputsModel")) { OutputsModel <- QcontribDown - if (is.null(OutputsModel$WarmUpQsim)) { - OutputsModel$WarmUpQsim <- rep(NA, length(RunOptions$IndPeriod_WarmUp)) + if (is.null(OutputsModel$RunOptions$WarmUpQsim)) { + OutputsModel$RunOptions$WarmUpQsim <- rep(NA, length(RunOptions$IndPeriod_WarmUp)) } - QsimDown <- c(OutputsModel$WarmUpQsim, OutputsModel$Qsim) + QsimDown <- c(OutputsModel$RunOptions$WarmUpQsim, OutputsModel$Qsim) } else if (is.vector(QcontribDown) && is.numeric(QcontribDown)) { OutputsModel <- list() class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1]) @@ -156,11 +156,11 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) { # message("StateEnd: ", paste(OutputsModel$StateEnd$SD, collapse = ", ")) } if ("WarmUpQsim" %in% RunOptions$Outputs_Sim) { - OutputsModel$WarmUpQsim <- Qsim_m3[seq_len(length(RunOptions$IndPeriod_WarmUp))] / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3 + OutputsModel$RunOptions$WarmUpQsim <- Qsim_m3[seq_len(length(RunOptions$IndPeriod_WarmUp))] / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3 } if ("Param" %in% RunOptions$Outputs_Sim) { - OutputsModel$Param <- c(Param, OutputsModel$Param) + OutputsModel$RunOptions$Param <- c(Param, OutputsModel$RunOptions$Param) } class(OutputsModel) <- c(class(OutputsModel), "SD") diff --git a/R/Utils.R b/R/Utils.R index 19892f3e..505f47f3 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -213,6 +213,9 @@ } return(res0) }) + if (!is.null(x$RunOptions)) { + res$RunOptions <- x$RunOptions + } if (!is.null(x$StateEnd)) { res$StateEnd <- x$StateEnd } @@ -221,7 +224,7 @@ } .IndexOutputsModel <- function(x, i) { -# '[.OutputsModel' <- function(x, i) { + # '[.OutputsModel' <- function(x, i) { if (!inherits(x, "OutputsModel")) { stop("'x' must be of class 'OutputsModel'") } diff --git a/R/UtilsErrorCrit.R b/R/UtilsErrorCrit.R index 8c8609f0..7854146b 100644 --- a/R/UtilsErrorCrit.R +++ b/R/UtilsErrorCrit.R @@ -49,7 +49,7 @@ Q = OutputsModel$Qsim, SCA = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio")), SWE = rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack")), - ParamT = OutputsModel$ParamT + ParamT = OutputsModel$RunOptions$ParamT ) VarSim[!InputsCrit$BoolCrit] <- NA diff --git a/R/UtilsRunModel.R b/R/UtilsRunModel.R index 846f0182..17476ede 100644 --- a/R/UtilsRunModel.R +++ b/R/UtilsRunModel.R @@ -39,18 +39,19 @@ } if ("WarmUpQsim" %in% RunOptions$Outputs_Sim) { - OutputsModel$WarmUpQsim <- RESULTS$Outputs[seq_len(length(RunOptions$IndPeriod_WarmUp)), + OutputsModel$RunOptions$WarmUpQsim <- RESULTS$Outputs[seq_len(length(RunOptions$IndPeriod_WarmUp)), which(FortranOutputs == "Qsim")] - class(OutputsModel$WarmUpQsim) <- c("WarmUpOutputsModelItem", class(OutputsModel$WarmUpQsim)) + # class(OutputsModel$RunOptions$WarmUpQsim) <- c("WarmUpOutputsModelItem", class(OutputsModel$RunOptions$WarmUpQsim)) + } + + if ("Param" %in% RunOptions$Outputs_Sim) { + OutputsModel$RunOptions$Param <- Param } if ("StateEnd" %in% RunOptions$Outputs_Sim) { OutputsModel$StateEnd <- RESULTS$StateEnd } - if ("Param" %in% RunOptions$Outputs_Sim) { - OutputsModel$Param <- Param - } class(OutputsModel) <- c("OutputsModel", class(RunOptions)[-1]) diff --git a/vignettes/V05_sd_model.Rmd b/vignettes/V05_sd_model.Rmd index 6c17770e..693dffb3 100644 --- a/vignettes/V05_sd_model.Rmd +++ b/vignettes/V05_sd_model.Rmd @@ -122,7 +122,7 @@ For using upstream simulated flows, we should concatenate a vector with the simu ```{r} Qsim_upstream <- rep(NA, length(BasinObs$DatesR)) # Simulated flow during warm-up period (365 days before run period) -Qsim_upstream[Ind_Run[seq_len(365)] - 365] <- OutputsModelUp$WarmUpQsim +Qsim_upstream[Ind_Run[seq_len(365)] - 365] <- OutputsModelUp$RunOptions$WarmUpQsim # Simulated flow during run period Qsim_upstream[Ind_Run] <- OutputsModelUp$Qsim -- GitLab