diff --git a/DESCRIPTION b/DESCRIPTION index adeea7229f010d05b0e017feaac3e67ceacafa71..d3ff8d20db36075aaa4d6a8369dff7adbf6e4a48 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.6.3.13 -Date: 2020-10-14 +Version: 1.6.3.14 +Date: 2020-10-15 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"), diff --git a/NEWS.md b/NEWS.md index 07984554876f5e14ff9626051a043b7810ef2126..a7ffac71ee2c6475760f42df60ce0f2245927692 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ -### 1.6.3.13 Release Notes (2020-10-14) +### 1.6.3.14 Release Notes (2020-10-15) #### New features diff --git a/tests/testthat/test-RunModel_LAG.R b/tests/testthat/test-RunModel_LAG.R index 7dd2aeef3d617890a3ff82cc4f41fc6ad51edc29..ccd59083ea63848f0674382ce6af60d528a9aaed 100644 --- a/tests/testthat/test-RunModel_LAG.R +++ b/tests/testthat/test-RunModel_LAG.R @@ -35,7 +35,7 @@ test_that("'Qupstream' cannot contain any NA value", { }) # Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs -Qupstream = floor((sin((1:length(BasinObs$Qmm)/365*2*3.14))+1)*mean(BasinObs$Qmm, na.rm = T)) +Qupstream <- floor((sin((seq_along(length(BasinObs$Qmm))/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE)) InputsModel <- CreateInputsModel( FUN_MOD = RunModel_GR4J, @@ -56,23 +56,22 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J, test_that("InputsModel parameter should contain an OutputsModel key", { expect_error( - RunModel_Lag(InputsModel, RunOptions, 1), + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), regexp = "'InputsModel' should contain an 'OutputsModel' key" ) }) -Param = c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started +Param <- c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started -OutputsGR4JOnly <- - RunModel_GR4J(InputsModel = InputsModel, - RunOptions = RunOptions, - Param = Param) +OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = Param) test_that("InputsModel$OutputsModel should contain a Qsim key", { InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel$Qsim <- NULL expect_error( - RunModel_Lag(InputsModel, RunOptions, 1), + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), regexp = "should contain a key 'Qsim'" ) }) @@ -81,67 +80,57 @@ test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOpt InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0) expect_error( - RunModel_Lag(InputsModel, RunOptions, 1), + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), regexp = "should have the same lenght as" ) }) test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", { InputsModel$OutputsModel <- OutputsGR4JOnly - InputsModel$OutputsModel$Qsim[10] <- NA + InputsModel$OutputsModel$Qsim[10L] <- NA expect_error( - RunModel_Lag(InputsModel, RunOptions, 1), + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), regexp = "contain no NA" ) }) test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { - UpstBasinArea = InputsModel$BasinAreas[1] - InputsModel$BasinAreas[1] <- 0 - OutputsSD <- - RunModel(InputsModel, - RunOptions, - Param = c(1, Param), - FUN_MOD = RunModel_GR4J) + UpstBasinArea <- InputsModel$BasinAreas[1L] + InputsModel$BasinAreas[1L] <- 0 + OutputsSD <- RunModel(InputsModel, + RunOptions, + Param = c(1, Param), + FUN_MOD = RunModel_GR4J) expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim) }) -test_that( - "Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", - { - InputsModel$LengthHydro <- 0 - InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0) - OutputsSD <- - RunModel(InputsModel, - RunOptions, - Param = c(1, Param), - FUN_MOD = RunModel_GR4J) - expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run]) - } -) +test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", { + InputsModel$LengthHydro <- 0 + InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0) + OutputsSD <- RunModel(InputsModel, + RunOptions, + Param = c(1, Param), + FUN_MOD = RunModel_GR4J) + expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run]) +}) -ParamSD = c(InputsModel$LengthHydro / (24 * 60 * 60), Param) # Speed corresponding to one time step delay +ParamSD <- c(InputsModel$LengthHydro / (24 * 60 * 60), Param) # Speed corresponding to one time step delay -QlsGR4Only <- - OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2] * 1E6 / 86400 +QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2L] * 1e6 / 86400 test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", { - OutputsSD <- - RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) - QlsSdSim <- - OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400 - QlsUpstLagObs <- - c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1] * 1E6 / 86400 + OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) + QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400 + QlsUpstLagObs <- c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1L] * 1e6 / 86400 expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) }) test_that("1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step", { - OutputsSD <- - RunModel(InputsModel, RunOptions, Param = c(InputsModel$LengthHydro / (12 * 3600), Param), FUN_MOD = RunModel_GR4J) - QlsSdSim <- - OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400 - QlsUpstLagObs <- - (Qupstream[Ind_Run] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]))/2 * InputsModel$BasinAreas[1] * 1E6 / 86400 + OutputsSD <- RunModel(InputsModel, RunOptions, + Param = c(InputsModel$LengthHydro / (12 * 3600), Param), + FUN_MOD = RunModel_GR4J) + QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400 + QlsUpstLagObs <- (Qupstream[Ind_Run] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]))/2 * InputsModel$BasinAreas[1L] * 1e6 / 86400 expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) }) @@ -153,8 +142,8 @@ test_that("Params from calibration with simulated data should be similar to init RunOptions = RunOptions, VarObs = "Q", Obs = ( - c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1] + - BasinObs$Qmm[Ind_Run] * BasinAreas[2] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] + + BasinObs$Qmm[Ind_Run] * BasinAreas[2L] ) / sum(BasinAreas) ) CalibOptions <- CreateCalibOptions( @@ -169,26 +158,23 @@ test_that("Params from calibration with simulated data should be similar to init CalibOptions = CalibOptions, FUN_MOD = RunModel_GR4J ) - expect_equal(OutputsCalib$ParamFinalR[2:5] / ParamSD[2:5], rep(1, 4), tolerance = 1E-2) - expect_equal(OutputsCalib$ParamFinalR[1], ParamSD[1], tolerance = 2E-3) + expect_equal(OutputsCalib$ParamFinalR[2:5] / ParamSD[2:5], rep(1, 4), tolerance = 1e-2) + expect_equal(OutputsCalib$ParamFinalR[1L], ParamSD[1L], tolerance = 2e-3) }) test_that("1 no area input with lag of 1 time step delay out gives an output delayed of one time step converted to mm", { - Qm3GR4Only <- - OutputsGR4JOnly$Qsim * BasinAreas[2] * 1E3 + Qm3GR4Only <- OutputsGR4JOnly$Qsim * BasinAreas[2L] * 1e3 # Specify that upstream flow is not related to an area - InputsModel$BasinAreas = c(NA, BasinAreas[2]) + InputsModel$BasinAreas <- c(NA, BasinAreas[2L]) # Convert upstream flow to m3/day - InputsModel$Qupstream <- matrix(Qupstream, ncol = 1) * BasinAreas[1] * 1E3 - - OutputsSD <- - RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) - + InputsModel$Qupstream <- matrix(Qupstream, ncol = 1) * BasinAreas[1L] * 1e3 + + OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) + expect_false(any(is.na(OutputsSD$Qsim))) - - Qm3SdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas, na.rm = TRUE) * 1E3 - Qm3UpstLagObs <- - c(0, InputsModel$Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) - + + Qm3SdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas, na.rm = TRUE) * 1e3 + Qm3UpstLagObs <- c(0, InputsModel$Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) + expect_equal(Qm3SdSim - Qm3GR4Only, Qm3UpstLagObs) })