Commit c97be9fb authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.6.3.14 style(test): minor typo revisions

parent d5ac0907
Pipeline #16669 canceled with stages
in 1 minute and 8 seconds
Package: airGR Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.3.13 Version: 1.6.3.14
Date: 2020-10-14 Date: 2020-10-15
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), 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"), person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
### 1.6.3.13 Release Notes (2020-10-14) ### 1.6.3.14 Release Notes (2020-10-15)
#### New features #### New features
......
...@@ -35,7 +35,7 @@ test_that("'Qupstream' cannot contain any NA value", { ...@@ -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 = 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( InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, FUN_MOD = RunModel_GR4J,
...@@ -56,23 +56,22 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J, ...@@ -56,23 +56,22 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
test_that("InputsModel parameter should contain an OutputsModel key", { test_that("InputsModel parameter should contain an OutputsModel key", {
expect_error( expect_error(
RunModel_Lag(InputsModel, RunOptions, 1), RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
regexp = "'InputsModel' should contain an 'OutputsModel' key" 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 <- OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel,
RunModel_GR4J(InputsModel = InputsModel, RunOptions = RunOptions,
RunOptions = RunOptions, Param = Param)
Param = Param)
test_that("InputsModel$OutputsModel should contain a Qsim key", { test_that("InputsModel$OutputsModel should contain a Qsim key", {
InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel <- OutputsGR4JOnly
InputsModel$OutputsModel$Qsim <- NULL InputsModel$OutputsModel$Qsim <- NULL
expect_error( expect_error(
RunModel_Lag(InputsModel, RunOptions, 1), RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
regexp = "should contain a key 'Qsim'" regexp = "should contain a key 'Qsim'"
) )
}) })
...@@ -81,67 +80,57 @@ test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOpt ...@@ -81,67 +80,57 @@ test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOpt
InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel <- OutputsGR4JOnly
InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0) InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0)
expect_error( expect_error(
RunModel_Lag(InputsModel, RunOptions, 1), RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
regexp = "should have the same lenght as" regexp = "should have the same lenght as"
) )
}) })
test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", { test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", {
InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel <- OutputsGR4JOnly
InputsModel$OutputsModel$Qsim[10] <- NA InputsModel$OutputsModel$Qsim[10L] <- NA
expect_error( expect_error(
RunModel_Lag(InputsModel, RunOptions, 1), RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
regexp = "contain no NA" regexp = "contain no NA"
) )
}) })
test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
UpstBasinArea = InputsModel$BasinAreas[1] UpstBasinArea <- InputsModel$BasinAreas[1L]
InputsModel$BasinAreas[1] <- 0 InputsModel$BasinAreas[1L] <- 0
OutputsSD <- OutputsSD <- RunModel(InputsModel,
RunModel(InputsModel, RunOptions,
RunOptions, Param = c(1, Param),
Param = c(1, Param), FUN_MOD = RunModel_GR4J)
FUN_MOD = RunModel_GR4J)
expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim) expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim)
}) })
test_that( test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", {
"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)
InputsModel$LengthHydro <- 0 OutputsSD <- RunModel(InputsModel,
InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0) RunOptions,
OutputsSD <- Param = c(1, Param),
RunModel(InputsModel, FUN_MOD = RunModel_GR4J)
RunOptions, expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run])
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 <- QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2L] * 1e6 / 86400
OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2] * 1E6 / 86400
test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", { test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", {
OutputsSD <- OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400
QlsSdSim <- QlsUpstLagObs <- c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1L] * 1e6 / 86400
OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400
QlsUpstLagObs <-
c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1] * 1E6 / 86400
expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) 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", { test_that("1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step", {
OutputsSD <- OutputsSD <- RunModel(InputsModel, RunOptions,
RunModel(InputsModel, RunOptions, Param = c(InputsModel$LengthHydro / (12 * 3600), Param), FUN_MOD = RunModel_GR4J) Param = c(InputsModel$LengthHydro / (12 * 3600), Param),
QlsSdSim <- FUN_MOD = RunModel_GR4J)
OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400 QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400
QlsUpstLagObs <- QlsUpstLagObs <- (Qupstream[Ind_Run] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]))/2 * InputsModel$BasinAreas[1L] * 1e6 / 86400
(Qupstream[Ind_Run] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]))/2 * InputsModel$BasinAreas[1] * 1E6 / 86400
expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
}) })
...@@ -153,8 +142,8 @@ test_that("Params from calibration with simulated data should be similar to init ...@@ -153,8 +142,8 @@ test_that("Params from calibration with simulated data should be similar to init
RunOptions = RunOptions, RunOptions = RunOptions,
VarObs = "Q", VarObs = "Q",
Obs = ( Obs = (
c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] +
BasinObs$Qmm[Ind_Run] * BasinAreas[2] BasinObs$Qmm[Ind_Run] * BasinAreas[2L]
) / sum(BasinAreas) ) / sum(BasinAreas)
) )
CalibOptions <- CreateCalibOptions( CalibOptions <- CreateCalibOptions(
...@@ -169,26 +158,23 @@ test_that("Params from calibration with simulated data should be similar to init ...@@ -169,26 +158,23 @@ test_that("Params from calibration with simulated data should be similar to init
CalibOptions = CalibOptions, CalibOptions = CalibOptions,
FUN_MOD = RunModel_GR4J FUN_MOD = RunModel_GR4J
) )
expect_equal(OutputsCalib$ParamFinalR[2:5] / ParamSD[2:5], rep(1, 4), tolerance = 1E-2) 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[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", { 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 <- Qm3GR4Only <- OutputsGR4JOnly$Qsim * BasinAreas[2L] * 1e3
OutputsGR4JOnly$Qsim * BasinAreas[2] * 1E3
# Specify that upstream flow is not related to an area # 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 # Convert upstream flow to m3/day
InputsModel$Qupstream <- matrix(Qupstream, ncol = 1) * BasinAreas[1] * 1E3 InputsModel$Qupstream <- matrix(Qupstream, ncol = 1) * BasinAreas[1L] * 1e3
OutputsSD <- OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
expect_false(any(is.na(OutputsSD$Qsim))) expect_false(any(is.na(OutputsSD$Qsim)))
Qm3SdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas, na.rm = TRUE) * 1E3 Qm3SdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas, na.rm = TRUE) * 1e3
Qm3UpstLagObs <- Qm3UpstLagObs <- c(0, InputsModel$Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]])
c(0, InputsModel$Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]])
expect_equal(Qm3SdSim - Qm3GR4Only, Qm3UpstLagObs) expect_equal(Qm3SdSim - Qm3GR4Only, Qm3UpstLagObs)
}) })
Markdown is supported
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