diff --git a/R/RunModel.R b/R/RunModel.R index eb63f41e6cd2d1f2f3812358aff9aa67e31760ea..c21b803cfb83b02de22136b46a0ad95f38d94424 100644 --- a/R/RunModel.R +++ b/R/RunModel.R @@ -1,8 +1,8 @@ -RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) { +RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD, ...) { FUN_MOD <- match.fun(FUN_MOD) - if (inherits(InputsModel, "SD")) { + if (inherits(InputsModel, "SD") && !identical(FUN_MOD, RunModel_Lag)) { # Lag model take one parameter at the beginning of the vector iFirstParamRunOffModel <- 2 } else { @@ -11,9 +11,9 @@ RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) { } OutputsModel <- FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions, - Param = Param[iFirstParamRunOffModel:length(Param)]) + Param = Param[iFirstParamRunOffModel:length(Param)], ...) - if (inherits(InputsModel, "SD")) { + if (inherits(InputsModel, "SD") && !identical(FUN_MOD, RunModel_Lag)) { OutputsModel <- RunModel_Lag(InputsModel, RunOptions, Param[1], OutputsModel) } return(OutputsModel) diff --git a/tests/testthat/test-RunModel_Lag.R b/tests/testthat/test-RunModel_Lag.R index 924b02ac07d913787a33d9b9ce416da4b59ef61f..cd291693d7148470ae37840c94e97a69560866dc 100644 --- a/tests/testthat/test-RunModel_Lag.R +++ b/tests/testthat/test-RunModel_Lag.R @@ -79,6 +79,20 @@ test_that("'QcontribDown$Qim' should have the same lenght as 'RunOptions$IndPeri ) }) +test_that("RunModel(FUN=RunModel_Lag) should give same result as RunModel_Lag", { + QcontribDown <- OutputsGR4JOnly + Output_RunModel_Lag <- RunModel_Lag(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = 1, + QcontribDown = QcontribDown) + Output_RunModel <- RunModel(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = 1, + FUN_MOD = RunModel_Lag, + QcontribDown = QcontribDown) + expect_equal(Output_RunModel, Output_RunModel_Lag) +}) + test_that("'Qupstream' contain NA values", { expect_warning( InputsModel <- CreateInputsModel( @@ -97,7 +111,7 @@ test_that("'Qupstream' contain NA values", { InputsModel = InputsModel, IndPeriod_Run = Ind_Run)) QcontribDown <- OutputsGR4JOnly - # Warning with RunModel + # Warning with RunModel_Lag expect_warning( RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown), regexp = "time steps with NA values"