From 00b34ae53f85f3d021fbe59e1cc6e7be13b39bcf Mon Sep 17 00:00:00 2001
From: David <david.dorchies@inrae.fr>
Date: Tue, 31 Dec 2024 17:05:40 +0100
Subject: [PATCH] test(RunModel.GRiwrmOutputsModel): add simple test for one
node
Refs #179
---
.../test-RunModel.GRiwrmOutputsModel.R | 69 ++++++++++++++++---
1 file changed, 61 insertions(+), 8 deletions(-)
diff --git a/tests/testthat/test-RunModel.GRiwrmOutputsModel.R b/tests/testthat/test-RunModel.GRiwrmOutputsModel.R
index 9ee98b0..134a5a0 100644
--- a/tests/testthat/test-RunModel.GRiwrmOutputsModel.R
+++ b/tests/testthat/test-RunModel.GRiwrmOutputsModel.R
@@ -1,5 +1,62 @@
skip_on_cran()
+data(Severn)
+
+test_that("Single node returns same result as RunModel.GRiwrmInputsModel", {
+ nodes <- loadSevernNodes()
+ nodes <- nodes[nodes$id == "54029", ]
+ nodes$down <- NA_character_
+ nodes$length <- NA_real_
+ e <- setupRunModel(
+ runRunOptions = FALSE,
+ griwrm = CreateGRiwrm(nodes)
+ )
+ for (x in ls(e)) assign(x, get(x, e))
+ ROref <- CreateRunOptions(
+ InputsModel,
+ IndPeriod_WarmUp = 1:364,
+ IndPeriod_Run = 365:366
+ )
+ OMref <- RunModel(
+ InputsModel,
+ RunOptions = ROref,
+ Param = ParamMichel
+ )
+ ROwarmUp <- CreateRunOptions(
+ InputsModel,
+ IndPeriod_WarmUp = 1:364,
+ IndPeriod_Run = 365L
+ )
+ OMwarmUp <- RunModel(
+ InputsModel,
+ RunOptions = ROwarmUp,
+ Param = ParamMichel
+ )
+ ROhotStart <- CreateRunOptions(
+ InputsModel,
+ IniStates = lapply(OMwarmUp, "[[", "StateEnd"),
+ IndPeriod_WarmUp = 0L,
+ IndPeriod_Run = 366L
+ )
+ ROhotStart$`54029`$IniResLevels <- NULL
+ # State Initiation
+ ROtest <- ROwarmUp
+ for (id in names(ROtest)) {
+ # Run model for the sub-basin and one time step
+ ROtest[[id]]$IniResLevels <- NULL
+ ROtest[[id]]$IniStates <- serializeIniStates(OMwarmUp[[id]]$StateEnd, InputsModel[[id]])
+ ROtest[[id]]$IndPeriod_WarmUp <- 0L
+ ROtest[[id]]$IndPeriod_Run <- 366L
+ }
+ expect_equal(ROtest$`54029`, ROhotStart$`54029`)
+ OMtest <- RunModel(OMwarmUp,
+ InputsModel = InputsModel,
+ RunOptions = ROwarmUp,
+ IndPeriod_Run = 366L
+ )
+ expect_equal(OMtest$`54029`, OMref$`54029`)
+})
+
# Setup model
griwrm <- CreateGRiwrm(rbind(
n_derived_rsrvr,
@@ -11,8 +68,7 @@ griwrm <- CreateGRiwrm(rbind(
model = NA
)
))
-data(Severn)
-DatesR <- Severn$BasinsObs[[1]]$DatesR
+DatesR <- Severn$BasinsObs[[1]]$DatesR
Qinf <- data.frame(
# Diversion to the dam
`54095` = rep(-1E6, length(DatesR)),
@@ -51,9 +107,7 @@ ROO <- CreateRunOptions(InputsModel, IndPeriod_WarmUp = 1:364, IndPeriod_Run = 3
OM <- RunModel(InputsModel, ROO, Param)
test_that("RunModel.GRiwrmOutputsModel works with InputsModel", {
-
- for(ym in unique(dfTS$yearmonth[dfTS$DatesR > OM[[1]]$DatesR])) {
-
+ for (ym in unique(dfTS$yearmonth[dfTS$DatesR > OM[[1]]$DatesR])) {
# Preparing extract of Qinf for the current run
ym_IndPeriod_Run <- which(dfTS$yearmonth == ym)
ym_Qinf <- Qinf[ym_IndPeriod_Run, , drop = FALSE]
@@ -73,11 +127,10 @@ test_that("RunModel.GRiwrmOutputsModel works with InputsModel", {
expect_equal(nrow(attr(OM, "Qm3s")), nrow(dfTS) - 364)
expect_equal(length(OM[[1]]$DatesR), nrow(dfTS) - 364)
- expect_equal(str(attr(OM, "Qm3s")), str(attr(OMref, "Qm3s")))
+ expect_equal(attr(OM, "Qm3s"), attr(OMref, "Qm3s"))
})
test_that("RunModel.GRiwrmOutputsModel works with Supervisor", {
-
sv <- CreateSupervisor(InputsModel)
curve <- approx(x = c(31*11 - 365, 30 * 6, 31 * 11, 366 + 30 * 6),
@@ -99,7 +152,7 @@ test_that("RunModel.GRiwrmOutputsModel works with Supervisor", {
U = "Dam",
fn_guide_curve)
- for(ym in unique(dfTS$yearmonth[dfTS$DatesR > OM[[1]]$DatesR])) {
+ for (ym in unique(dfTS$yearmonth[dfTS$DatesR > OM[[1]]$DatesR])) {
message("Processing period ", ym)
# Preparing extract of Qinf for the current run
ym_IndPeriod_Run <- which(dfTS$yearmonth == ym)
--
GitLab