Skip to content

GitLab

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

test(style): indent code and review some minor typo in many test files

parent 12072dba
Pipeline #19716 passed with stages
in 11 minutes and 50 seconds
Hide whitespace changes
Inline Side-by-side
tests/testthat/helper_vignettes.R
View file @ de0e5f5a
......@@ -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
}
tests/testthat/regression.R
View file @ de0e5f5a
......@@ -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",
......
tests/testthat/regression_tests.R
View file @ de0e5f5a
......@@ -3,7 +3,7 @@ Args <- commandArgs(trailingOnly = TRUE)
source("tests/testthat/helper_regression.R")
lActions = list(
lActions <- list(
stable = StoreStableExampleResults,
dev = StoreDevExampleResults,
compare = CompareStableDev
......
tests/testthat/test-CreateRunOptions.R
View file @ de0e5f5a
......@@ -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,
......
tests/testthat/test-RunModel_LAG.R
View file @ de0e5f5a
......@@ -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])
......
tests/testthat/test-SeriesAggreg.R
View file @ de0e5f5a
......@@ -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")})
})
......
tests/testthat/test-evap.R
View file @ de0e5f5a
......@@ -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))
})
tests/testthat/test-vignettes.R
View file @ de0e5f5a
......@@ -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)
})
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