From de0e5f5ae320ce4a79a54a87b64282f2fa8e135f Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.fr>
Date: Thu, 28 Jan 2021 11:18:56 +0100
Subject: [PATCH] test(style): indent code and review some minor typo in many
test files
---
tests/testthat/helper_vignettes.R | 20 +++++++++----------
tests/testthat/regression.R | 2 +-
tests/testthat/regression_tests.R | 2 +-
tests/testthat/test-CreateRunOptions.R | 19 ++++++++++--------
tests/testthat/test-RunModel_LAG.R | 27 +++++++++++++++-----------
tests/testthat/test-SeriesAggreg.R | 2 +-
tests/testthat/test-evap.R | 15 +++++++-------
tests/testthat/test-vignettes.R | 16 +++++++--------
8 files changed, 55 insertions(+), 48 deletions(-)
diff --git a/tests/testthat/helper_vignettes.R b/tests/testthat/helper_vignettes.R
index 8dfe5e12..931f99a5 100644
--- a/tests/testthat/helper_vignettes.R
+++ b/tests/testthat/helper_vignettes.R
@@ -3,12 +3,12 @@
#' @param fileRmd Rmd file to
#' @param tmpFolder Folder storing the script containing extracted chunks
#' @param force.eval Force execution of chunks with parameter eval=FALSE
-RunRmdChunks <- function(fileRmd,
- tmpFolder = "../tmp",
- force.eval = TRUE) {
+RunRmdChunks <- function(fileRmd,
+ tmpFolder = "../tmp",
+ force.eval = TRUE) {
dir.create(tmpFolder, showWarnings = FALSE)
output <- file.path(tmpFolder,
- gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE))
+ gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE))
knitr::purl(fileRmd, output = output, quiet = TRUE)
sTxt <- readLines(output)
if (force.eval) {
@@ -30,8 +30,8 @@ RunRmdChunks <- function(fileRmd,
for (i in 1:length(chunksEvalStart)) {
# Remove comments on eval=F chunk lines
sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] <- gsub(pattern = "^## ",
- replace = "",
- x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]])
+ replace = "",
+ x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]])
}
}
@@ -70,12 +70,12 @@ RunRmdChunks <- function(fileRmd,
RunVignetteChunks <- function(vignette,
tmpFolder = "../tmp",
force.eval = TRUE) {
- if(file.exists(file.path("../../vignettes/", paste0(vignette, ".Rmd")))) {
+ if(file.exists(sprintf("../../vignettes/%s.Rmd", vignette))) {
# testthat context in development environnement
- RunRmdChunks(file.path("../../vignettes/", paste0(vignette, ".Rmd")), tmpFolder, force.eval)
+ RunRmdChunks(sprintf("../../vignettes/%s.Rmd", vignette), tmpFolder, force.eval)
} else {
# R CMD check context in package environnement
- RunRmdChunks(system.file(file.path("doc/", paste0(vignette, ".Rmd")), package = "airGR"), tmpFolder, force.eval)
+ RunRmdChunks(system.file(sprintf("doc/%s.Rmd", vignette), package = "airGR"), tmpFolder, force.eval)
}
return(TRUE)
}
@@ -92,4 +92,4 @@ TestQmmQlsConversion <- function(BasinObs, BasinArea, tolerance = 1E-7) {
Conversion <- Conversion / 86400 # Day -> seconds
notNA <- which(!is.na(BasinObs$Qmm))
expect_equal(BasinObs$Qmm[notNA] * Conversion, BasinObs$Qls[notNA], tolerance = tolerance)
-}
\ No newline at end of file
+}
diff --git a/tests/testthat/regression.R b/tests/testthat/regression.R
index 2ccadba4..1732b2c5 100644
--- a/tests/testthat/regression.R
+++ b/tests/testthat/regression.R
@@ -35,7 +35,7 @@ if (dir.exists(file.path(tmp_path, "stable")) & dir.exists(file.path(tmp_path, "
message("File ", file.path(getwd(), regIgnoreFile), " not found")
regIgnore <- NULL
}
- lapply(X = refVarFiles, CompareWithStable, testDir = file.path(tmp_path, "dev"), regIgnore = regIgnore)
+ lapply(refVarFiles, FUN = CompareWithStable, testDir = file.path(tmp_path, "dev"), regIgnore = regIgnore)
} else {
stop("Regression tests compared to released version needs that you run the following instructions first:\n",
"Rscript tests/testthat/regression_tests.R stable\n",
diff --git a/tests/testthat/regression_tests.R b/tests/testthat/regression_tests.R
index 8a141ce3..4456e09e 100644
--- a/tests/testthat/regression_tests.R
+++ b/tests/testthat/regression_tests.R
@@ -3,7 +3,7 @@ Args <- commandArgs(trailingOnly = TRUE)
source("tests/testthat/helper_regression.R")
-lActions = list(
+lActions <- list(
stable = StoreStableExampleResults,
dev = StoreDevExampleResults,
compare = CompareStableDev
diff --git a/tests/testthat/test-CreateRunOptions.R b/tests/testthat/test-CreateRunOptions.R
index 91723330..08c877dd 100644
--- a/tests/testthat/test-CreateRunOptions.R
+++ b/tests/testthat/test-CreateRunOptions.R
@@ -2,26 +2,29 @@ context("CreateRunOptions")
test_that("Warm start of GR4J should give same result as warmed model", {
data(L0123001)
- InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+ InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E)
Param <- c(X1 = 257.238, X2 = 1.012, X3 = 88.235, X4 = 2.208)
- Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"),
- which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31"))
- Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"),
+ Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"),
+ which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31"))
+ Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"),
which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31"))
# 1990-1991
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
- InputsModel = InputsModel, IndPeriod_Run = c(Ind_Run1, Ind_Run2)))
+ InputsModel = InputsModel,
+ IndPeriod_Run = c(Ind_Run1, Ind_Run2)))
OutputsModel <- RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions, Param = Param)
# 1990
RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
- InputsModel = InputsModel, IndPeriod_Run = Ind_Run1))
+ InputsModel = InputsModel,
+ IndPeriod_Run = Ind_Run1))
OutputsModel1 <- RunModel_GR4J(InputsModel = InputsModel,
- RunOptions = RunOptions1, Param = Param)
+ RunOptions = RunOptions1, Param = Param)
# Warm start 1991
RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
- InputsModel = InputsModel, IndPeriod_Run = Ind_Run2,
+ InputsModel = InputsModel,
+ IndPeriod_Run = Ind_Run2,
IndPeriod_WarmUp = 0L,
IniStates = OutputsModel1$StateEnd)
OutputsModel2 <- RunModel_GR4J(InputsModel = InputsModel,
diff --git a/tests/testthat/test-RunModel_LAG.R b/tests/testthat/test-RunModel_LAG.R
index 00d0104a..bfef15d2 100644
--- a/tests/testthat/test-RunModel_LAG.R
+++ b/tests/testthat/test-RunModel_LAG.R
@@ -51,8 +51,8 @@ Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01
which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
- InputsModel = InputsModel,
- IndPeriod_Run = Ind_Run))
+ InputsModel = InputsModel,
+ IndPeriod_Run = Ind_Run))
test_that("InputsModel parameter should contain an OutputsModel key", {
expect_error(
@@ -140,10 +140,8 @@ test_that("Params from calibration with simulated data should be similar to init
InputsModel = InputsModel,
RunOptions = RunOptions,
VarObs = "Q",
- Obs = (
- c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] +
- BasinObs$Qmm[Ind_Run] * BasinAreas[2L]
- ) / sum(BasinAreas)
+ Obs = (c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] +
+ BasinObs$Qmm[Ind_Run] * BasinAreas[2L]) / sum(BasinAreas)
)
CalibOptions <- CreateCalibOptions(
FUN_MOD = RunModel_GR4J,
@@ -193,14 +191,19 @@ Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"
# 1990
RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
- InputsModel = IM, IndPeriod_Run = Ind_Run1))
+ InputsModel = IM,
+ IndPeriod_Run = Ind_Run1))
OutputsModel1 <- RunModel(InputsModel = IM,
- RunOptions = RunOptions1, Param = PSDini, FUN_MOD = RunModel_GR4J)
+ RunOptions = RunOptions1, Param = PSDini,
+ FUN_MOD = RunModel_GR4J)
# 1990-1991
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
- InputsModel = IM, IndPeriod_Run = c(Ind_Run1, Ind_Run2)))
+ InputsModel = IM,
+ IndPeriod_Run = c(Ind_Run1, Ind_Run2)))
OutputsModel <- RunModel(InputsModel = IM,
- RunOptions = RunOptions, Param = PSDini, FUN_MOD = RunModel_GR4J)
+ RunOptions = RunOptions,
+ Param = PSDini,
+ FUN_MOD = RunModel_GR4J)
test_that("Warm start should give same result as warmed model", {
# Warm start 1991
@@ -209,7 +212,9 @@ test_that("Warm start should give same result as warmed model", {
IndPeriod_WarmUp = 0L,
IniStates = OutputsModel1$StateEnd)
OutputsModel2 <- RunModel(InputsModel = IM,
- RunOptions = RunOptions2, Param = PSDini, FUN_MOD = RunModel_GR4J)
+ RunOptions = RunOptions2,
+ Param = PSDini,
+ FUN_MOD = RunModel_GR4J)
# Compare 1991 Qsim from warm started and from 1990-1991
names(OutputsModel2$Qsim) <- NULL
expect_equal(OutputsModel2$Qsim, OutputsModel$Qsim[366:730])
diff --git a/tests/testthat/test-SeriesAggreg.R b/tests/testthat/test-SeriesAggreg.R
index c9edc42e..48eb1afd 100644
--- a/tests/testthat/test-SeriesAggreg.R
+++ b/tests/testthat/test-SeriesAggreg.R
@@ -229,7 +229,7 @@ test_that("SeriesAggreg should work with ConvertFun 'min', 'max' and 'median'",
Qls <- BasinObs[, c("DatesR", "Qls")]
test_ConvertFunRegime <- function(x, ConvertFun, TimeFormat) {
expect_equal(nrow(SeriesAggreg(x, TimeFormat, ConvertFun = ConvertFun)),
- length(unique(format(BasinObs$DatesR, "%Y"))))
+ length(unique(format(BasinObs$DatesR, "%Y"))))
}
lapply(c("max", "min", "median"), function(x) {test_ConvertFunRegime(Qls, x, "%Y")})
})
diff --git a/tests/testthat/test-evap.R b/tests/testthat/test-evap.R
index aac8122d..e68a4715 100644
--- a/tests/testthat/test-evap.R
+++ b/tests/testthat/test-evap.R
@@ -6,7 +6,7 @@ comp_evap <- function(BasinObs,
TimeStepOut = "daily") {
PotEvap <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
Temp = BasinObs$T,
- Lat = Lat, LatUnit = LatUnit,
+ Lat = Lat, LatUnit = LatUnit,
TimeStepIn = TimeStepIn, TimeStepOut = TimeStepOut)
PotEvapFor <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
Temp = BasinObs$T,
@@ -19,7 +19,7 @@ comp_evap <- function(BasinObs,
test_that("PE_Oudin works", {
skip_on_cran()
rm(list = ls())
-
+
data(L0123001); BasinObs_L0123001 <- BasinObs
data(L0123002); BasinObs_L0123002 <- BasinObs
@@ -30,14 +30,14 @@ test_that("PE_Oudin works", {
Lat = 0.8, LatUnit = "rad",
TimeStepIn = "daily", TimeStepOut = "hourly"))
expect_true(comp_evap(BasinObs = BasinObs_L0123002,
- Lat = 0.9, LatUnit = "rad",
+ Lat = 0.9, LatUnit = "rad",
TimeStepIn = "daily", TimeStepOut = "daily"))
expect_true(comp_evap(BasinObs = BasinObs_L0123002,
Lat = 0.9, LatUnit = "rad",
TimeStepIn = "daily", TimeStepOut = "hourly"))
-
+
## check with several catchments using different values for Lat
-
+
## one by one
PotEvapFor1 <- PE_Oudin(JD = as.POSIXlt(BasinObs_L0123001$DatesR)$yday + 1,
Temp = BasinObs_L0123001$T,
@@ -47,7 +47,7 @@ test_that("PE_Oudin works", {
Temp = BasinObs_L0123002$T,
Lat = 0.9, LatUnit = "rad",
RunFortran = TRUE)
-
+
## all in one
BasinObs_L0123001$Lat <- 0.8
BasinObs_L0123002$Lat <- 0.9
@@ -56,7 +56,6 @@ test_that("PE_Oudin works", {
Temp = BasinObs$T,
Lat = BasinObs$Lat, LatUnit = "rad",
RunFortran = TRUE)
-
+
expect_equal(PotEvapFor, c(PotEvapFor1, PotEvapFor2))
-
})
diff --git a/tests/testthat/test-vignettes.R b/tests/testthat/test-vignettes.R
index 86d011f6..497cb7d8 100644
--- a/tests/testthat/test-vignettes.R
+++ b/tests/testthat/test-vignettes.R
@@ -14,8 +14,8 @@ test_that("V02.1_param_optim works", {
rda_resGLOB <- resGLOB
rda_resPORT <- resPORT
expect_true(RunVignetteChunks("V02.1_param_optim"))
- expect_equal(summary(resGLOB), summary(rda_resGLOB), tolerance = 1E-7)
- expect_equal(resGLOB[,-1], rda_resGLOB[,-1], tolerance = 1E-2) # High tolerance due to randomisation in optimisations
+ expect_equal(summary(resGLOB), summary(rda_resGLOB), tolerance = 1e-7)
+ expect_equal(resGLOB[, -1], rda_resGLOB[, -1], tolerance = 1e-2) # High tolerance due to randomisation in optimisations
})
test_that("V02.2_param_mcmc works", {
@@ -25,8 +25,8 @@ test_that("V02.2_param_mcmc works", {
rda_gelRub <- gelRub
rda_multDRAM <- multDRAM
expect_true(RunVignetteChunks("V02.2_param_mcmc"))
- expect_equal(gelRub, rda_gelRub, tolerance = 1E-7)
- expect_equal(multDRAM, rda_multDRAM, tolerance = 1E-7)
+ expect_equal(gelRub, rda_gelRub, tolerance = 1e-7)
+ expect_equal(multDRAM, rda_multDRAM, tolerance = 1e-7)
})
test_that("V03_param_sets_GR4J works", {
@@ -45,8 +45,8 @@ test_that("V04_cemaneige_hysteresis works", {
rda_OutputsCrit_Val_NoHyst <- OutputsCrit_Val_NoHyst
expect_true(RunVignetteChunks("V04_cemaneige_hysteresis"))
TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea)
- expect_equal(OutputsCrit_Cal, rda_OutputsCrit_Cal, tolerance = 1E-7)
- expect_equal(OutputsCrit_Cal_NoHyst, rda_OutputsCrit_Cal_NoHyst, tolerance = 1E-7)
- expect_equal(OutputsCrit_Val, rda_OutputsCrit_Val, tolerance = 1E-7)
- expect_equal(OutputsCrit_Val_NoHyst, rda_OutputsCrit_Val_NoHyst, tolerance = 1E-7)
+ expect_equal(OutputsCrit_Cal, rda_OutputsCrit_Cal, tolerance = 1e-7)
+ expect_equal(OutputsCrit_Cal_NoHyst, rda_OutputsCrit_Cal_NoHyst, tolerance = 1e-7)
+ expect_equal(OutputsCrit_Val, rda_OutputsCrit_Val, tolerance = 1e-7)
+ expect_equal(OutputsCrit_Val_NoHyst, rda_OutputsCrit_Val_NoHyst, tolerance = 1e-7)
})
--
GitLab