Commit 00b34ae5 authored by David's avatar David
Browse files

test(RunModel.GRiwrmOutputsModel): add simple test for one node

Refs #179
Showing with 61 additions and 8 deletions
+61 -8
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)
......
Supports Markdown
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