diff --git a/R/CreateSupervisor.R b/R/CreateSupervisor.R index 5b24c222e216cc715ff68f19d336aff2be59b081..8af0483a9935d688cab6ea344800d9afa1b03976 100644 --- a/R/CreateSupervisor.R +++ b/R/CreateSupervisor.R @@ -39,9 +39,10 @@ CreateSupervisor <- function(InputsModel, TimeStep = 1L) { griwrm = e$griwrm) names(e$nodeProperties) <- unique(e$griwrm$id) dfNP <- do.call(rbind, lapply(e$nodeProperties, dplyr::bind_cols)) - + models4U <- c("Diversion", "RunModel_Reservoir") e$griwrm4U <- - e$griwrm[dfNP$Diversion | dfNP$DirectInjection | dfNP$Reservoir, ] + e$griwrm[is.na(e$griwrm$model) | + (!is.na(e$griwrm$model) & e$griwrm$model %in% models4U), ] e$OutputsModel <- list() e$.TimeStep <- TimeStep diff --git a/tests/testthat/test-CreateSupervisor.R b/tests/testthat/test-CreateSupervisor.R index 28bd79d2c75452ca22b218e40761dbc74e06eeca..3ba3e848c467626651b4147bec5d774bcda3d480 100644 --- a/tests/testthat/test-CreateSupervisor.R +++ b/tests/testthat/test-CreateSupervisor.R @@ -43,3 +43,22 @@ test_that("Checks in CreateController", { expect_s3_class(sv$controllers$toto, "Controller") }) +test_that("CreateSupervisor using reservoir and diversion", { + nodes <- loadSevernNodes() + nodes <- rbind(nodes, data.frame( + id = c("54029" , "Reservoir" ), + down = c("Reservoir" , "54032" ), + length = c(20 , 15 ), + area = c(NA, NA ), + model = c("Diversion" , "RunModel_Reservoir") + )) + g <- CreateGRiwrm(nodes) + # Add Qobs for the 2 new nodes and create InputsModel + Qobs <- matrix(data = rep(0, 2*length(DatesR)), ncol = 2) + colnames(Qobs) <- c("54029", "Reservoir") + InputsModel <- suppressWarnings( + CreateInputsModel(g, DatesR, Precip, PotEvap, Qobs) + ) + sv <- CreateSupervisor(InputsModel) + expect_equal(sv$griwrm4U$id, c("54029", "Reservoir")) +})