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
...@@ -3,12 +3,12 @@ ...@@ -3,12 +3,12 @@
#' @param fileRmd Rmd file to #' @param fileRmd Rmd file to
#' @param tmpFolder Folder storing the script containing extracted chunks #' @param tmpFolder Folder storing the script containing extracted chunks
#' @param force.eval Force execution of chunks with parameter eval=FALSE #' @param force.eval Force execution of chunks with parameter eval=FALSE
RunRmdChunks <- function(fileRmd, RunRmdChunks <- function(fileRmd,
tmpFolder = "../tmp", tmpFolder = "../tmp",
force.eval = TRUE) { force.eval = TRUE) {
dir.create(tmpFolder, showWarnings = FALSE) dir.create(tmpFolder, showWarnings = FALSE)
output <- file.path(tmpFolder, 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) knitr::purl(fileRmd, output = output, quiet = TRUE)
sTxt <- readLines(output) sTxt <- readLines(output)
if (force.eval) { if (force.eval) {
...@@ -30,8 +30,8 @@ RunRmdChunks <- function(fileRmd, ...@@ -30,8 +30,8 @@ RunRmdChunks <- function(fileRmd,
for (i in 1:length(chunksEvalStart)) { for (i in 1:length(chunksEvalStart)) {
# Remove comments on eval=F chunk lines # Remove comments on eval=F chunk lines
sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] <- gsub(pattern = "^## ", sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] <- gsub(pattern = "^## ",
replace = "", replace = "",
x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]]) x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]])
} }
} }
...@@ -70,12 +70,12 @@ RunRmdChunks <- function(fileRmd, ...@@ -70,12 +70,12 @@ RunRmdChunks <- function(fileRmd,
RunVignetteChunks <- function(vignette, RunVignetteChunks <- function(vignette,
tmpFolder = "../tmp", tmpFolder = "../tmp",
force.eval = TRUE) { 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 # 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 { } else {
# R CMD check context in package environnement # 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) return(TRUE)
} }
...@@ -92,4 +92,4 @@ TestQmmQlsConversion <- function(BasinObs, BasinArea, tolerance = 1E-7) { ...@@ -92,4 +92,4 @@ TestQmmQlsConversion <- function(BasinObs, BasinArea, tolerance = 1E-7) {
Conversion <- Conversion / 86400 # Day -> seconds Conversion <- Conversion / 86400 # Day -> seconds
notNA <- which(!is.na(BasinObs$Qmm)) notNA <- which(!is.na(BasinObs$Qmm))
expect_equal(BasinObs$Qmm[notNA] * Conversion, BasinObs$Qls[notNA], tolerance = tolerance) expect_equal(BasinObs$Qmm[notNA] * Conversion, BasinObs$Qls[notNA], tolerance = tolerance)
} }
\ No newline at end of file
...@@ -35,7 +35,7 @@ if (dir.exists(file.path(tmp_path, "stable")) & dir.exists(file.path(tmp_path, " ...@@ -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") message("File ", file.path(getwd(), regIgnoreFile), " not found")
regIgnore <- NULL 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 { } else {
stop("Regression tests compared to released version needs that you run the following instructions first:\n", stop("Regression tests compared to released version needs that you run the following instructions first:\n",
"Rscript tests/testthat/regression_tests.R stable\n", "Rscript tests/testthat/regression_tests.R stable\n",
......
...@@ -3,7 +3,7 @@ Args <- commandArgs(trailingOnly = TRUE) ...@@ -3,7 +3,7 @@ Args <- commandArgs(trailingOnly = TRUE)
source("tests/testthat/helper_regression.R") source("tests/testthat/helper_regression.R")
lActions = list( lActions <- list(
stable = StoreStableExampleResults, stable = StoreStableExampleResults,
dev = StoreDevExampleResults, dev = StoreDevExampleResults,
compare = CompareStableDev compare = CompareStableDev
......
...@@ -2,26 +2,29 @@ context("CreateRunOptions") ...@@ -2,26 +2,29 @@ context("CreateRunOptions")
test_that("Warm start of GR4J should give same result as warmed model", { test_that("Warm start of GR4J should give same result as warmed model", {
data(L0123001) 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) Precip = BasinObs$P, PotEvap = BasinObs$E)
Param <- c(X1 = 257.238, X2 = 1.012, X3 = 88.235, X4 = 2.208) 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"), 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")) 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_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"),
which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31")) which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31"))
# 1990-1991 # 1990-1991
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, 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, OutputsModel <- RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions, Param = Param) RunOptions = RunOptions, Param = Param)
# 1990 # 1990
RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel, IndPeriod_Run = Ind_Run1)) InputsModel = InputsModel,
IndPeriod_Run = Ind_Run1))
OutputsModel1 <- RunModel_GR4J(InputsModel = InputsModel, OutputsModel1 <- RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions1, Param = Param) RunOptions = RunOptions1, Param = Param)
# Warm start 1991 # Warm start 1991
RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J, RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel, IndPeriod_Run = Ind_Run2, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run2,
IndPeriod_WarmUp = 0L, IndPeriod_WarmUp = 0L,
IniStates = OutputsModel1$StateEnd) IniStates = OutputsModel1$StateEnd)
OutputsModel2 <- RunModel_GR4J(InputsModel = InputsModel, OutputsModel2 <- RunModel_GR4J(InputsModel = InputsModel,
......
...@@ -51,8 +51,8 @@ Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01 ...@@ -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")) which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel, InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)) IndPeriod_Run = Ind_Run))
test_that("InputsModel parameter should contain an OutputsModel key", { test_that("InputsModel parameter should contain an OutputsModel key", {
expect_error( expect_error(
...@@ -140,10 +140,8 @@ test_that("Params from calibration with simulated data should be similar to init ...@@ -140,10 +140,8 @@ test_that("Params from calibration with simulated data should be similar to init
InputsModel = InputsModel, InputsModel = InputsModel,
RunOptions = RunOptions, RunOptions = RunOptions,
VarObs = "Q", VarObs = "Q",
Obs = ( Obs = (c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] +
c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] + BasinObs$Qmm[Ind_Run] * BasinAreas[2L]) / sum(BasinAreas)
BasinObs$Qmm[Ind_Run] * BasinAreas[2L]
) / sum(BasinAreas)
) )
CalibOptions <- CreateCalibOptions( CalibOptions <- CreateCalibOptions(
FUN_MOD = RunModel_GR4J, FUN_MOD = RunModel_GR4J,
...@@ -193,14 +191,19 @@ Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01" ...@@ -193,14 +191,19 @@ Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"
# 1990 # 1990
RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = IM, IndPeriod_Run = Ind_Run1)) InputsModel = IM,
IndPeriod_Run = Ind_Run1))
OutputsModel1 <- RunModel(InputsModel = IM, OutputsModel1 <- RunModel(InputsModel = IM,
RunOptions = RunOptions1, Param = PSDini, FUN_MOD = RunModel_GR4J) RunOptions = RunOptions1, Param = PSDini,
FUN_MOD = RunModel_GR4J)
# 1990-1991 # 1990-1991
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, 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, 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", { test_that("Warm start should give same result as warmed model", {
# Warm start 1991 # Warm start 1991
...@@ -209,7 +212,9 @@ test_that("Warm start should give same result as warmed model", { ...@@ -209,7 +212,9 @@ test_that("Warm start should give same result as warmed model", {
IndPeriod_WarmUp = 0L, IndPeriod_WarmUp = 0L,
IniStates = OutputsModel1$StateEnd) IniStates = OutputsModel1$StateEnd)
OutputsModel2 <- RunModel(InputsModel = IM, 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 # Compare 1991 Qsim from warm started and from 1990-1991
names(OutputsModel2$Qsim) <- NULL names(OutputsModel2$Qsim) <- NULL
expect_equal(OutputsModel2$Qsim, OutputsModel$Qsim[366:730]) expect_equal(OutputsModel2$Qsim, OutputsModel$Qsim[366:730])
......
...@@ -229,7 +229,7 @@ test_that("SeriesAggreg should work with ConvertFun 'min', 'max' and 'median'", ...@@ -229,7 +229,7 @@ test_that("SeriesAggreg should work with ConvertFun 'min', 'max' and 'median'",
Qls <- BasinObs[, c("DatesR", "Qls")] Qls <- BasinObs[, c("DatesR", "Qls")]
test_ConvertFunRegime <- function(x, ConvertFun, TimeFormat) { test_ConvertFunRegime <- function(x, ConvertFun, TimeFormat) {
expect_equal(nrow(SeriesAggreg(x, TimeFormat, ConvertFun = ConvertFun)), 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")}) lapply(c("max", "min", "median"), function(x) {test_ConvertFunRegime(Qls, x, "%Y")})
}) })
......
...@@ -6,7 +6,7 @@ comp_evap <- function(BasinObs, ...@@ -6,7 +6,7 @@ comp_evap <- function(BasinObs,
TimeStepOut = "daily") { TimeStepOut = "daily") {
PotEvap <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1, PotEvap <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
Temp = BasinObs$T, Temp = BasinObs$T,
Lat = Lat, LatUnit = LatUnit, Lat = Lat, LatUnit = LatUnit,
TimeStepIn = TimeStepIn, TimeStepOut = TimeStepOut) TimeStepIn = TimeStepIn, TimeStepOut = TimeStepOut)
PotEvapFor <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1, PotEvapFor <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1,
Temp = BasinObs$T, Temp = BasinObs$T,
...@@ -19,7 +19,7 @@ comp_evap <- function(BasinObs, ...@@ -19,7 +19,7 @@ comp_evap <- function(BasinObs,
test_that("PE_Oudin works", { test_that("PE_Oudin works", {
skip_on_cran() skip_on_cran()
rm(list = ls()) rm(list = ls())
data(L0123001); BasinObs_L0123001 <- BasinObs data(L0123001); BasinObs_L0123001 <- BasinObs
data(L0123002); BasinObs_L0123002 <- BasinObs data(L0123002); BasinObs_L0123002 <- BasinObs
...@@ -30,14 +30,14 @@ test_that("PE_Oudin works", { ...@@ -30,14 +30,14 @@ test_that("PE_Oudin works", {
Lat = 0.8, LatUnit = "rad", Lat = 0.8, LatUnit = "rad",
TimeStepIn = "daily", TimeStepOut = "hourly")) TimeStepIn = "daily", TimeStepOut = "hourly"))
expect_true(comp_evap(BasinObs = BasinObs_L0123002, expect_true(comp_evap(BasinObs = BasinObs_L0123002,
Lat = 0.9, LatUnit = "rad", Lat = 0.9, LatUnit = "rad",
TimeStepIn = "daily", TimeStepOut = "daily")) TimeStepIn = "daily", TimeStepOut = "daily"))
expect_true(comp_evap(BasinObs = BasinObs_L0123002, expect_true(comp_evap(BasinObs = BasinObs_L0123002,
Lat = 0.9, LatUnit = "rad", Lat = 0.9, LatUnit = "rad",
TimeStepIn = "daily", TimeStepOut = "hourly")) TimeStepIn = "daily", TimeStepOut = "hourly"))
## check with several catchments using different values for Lat ## check with several catchments using different values for Lat
## one by one ## one by one
PotEvapFor1 <- PE_Oudin(JD = as.POSIXlt(BasinObs_L0123001$DatesR)$yday + 1, PotEvapFor1 <- PE_Oudin(JD = as.POSIXlt(BasinObs_L0123001$DatesR)$yday + 1,
Temp = BasinObs_L0123001$T, Temp = BasinObs_L0123001$T,
...@@ -47,7 +47,7 @@ test_that("PE_Oudin works", { ...@@ -47,7 +47,7 @@ test_that("PE_Oudin works", {
Temp = BasinObs_L0123002$T, Temp = BasinObs_L0123002$T,
Lat = 0.9, LatUnit = "rad", Lat = 0.9, LatUnit = "rad",
RunFortran = TRUE) RunFortran = TRUE)
## all in one ## all in one
BasinObs_L0123001$Lat <- 0.8 BasinObs_L0123001$Lat <- 0.8
BasinObs_L0123002$Lat <- 0.9 BasinObs_L0123002$Lat <- 0.9
...@@ -56,7 +56,6 @@ test_that("PE_Oudin works", { ...@@ -56,7 +56,6 @@ test_that("PE_Oudin works", {
Temp = BasinObs$T, Temp = BasinObs$T,
Lat = BasinObs$Lat, LatUnit = "rad", Lat = BasinObs$Lat, LatUnit = "rad",
RunFortran = TRUE) RunFortran = TRUE)
expect_equal(PotEvapFor, c(PotEvapFor1, PotEvapFor2)) expect_equal(PotEvapFor, c(PotEvapFor1, PotEvapFor2))
}) })
...@@ -14,8 +14,8 @@ test_that("V02.1_param_optim works", { ...@@ -14,8 +14,8 @@ test_that("V02.1_param_optim works", {
rda_resGLOB <- resGLOB rda_resGLOB <- resGLOB
rda_resPORT <- resPORT rda_resPORT <- resPORT
expect_true(RunVignetteChunks("V02.1_param_optim")) expect_true(RunVignetteChunks("V02.1_param_optim"))
expect_equal(summary(resGLOB), summary(rda_resGLOB), tolerance = 1E-7) 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(resGLOB[, -1], rda_resGLOB[, -1], tolerance = 1e-2) # High tolerance due to randomisation in optimisations
}) })
test_that("V02.2_param_mcmc works", { test_that("V02.2_param_mcmc works", {
...@@ -25,8 +25,8 @@ test_that("V02.2_param_mcmc works", { ...@@ -25,8 +25,8 @@ test_that("V02.2_param_mcmc works", {
rda_gelRub <- gelRub rda_gelRub <- gelRub
rda_multDRAM <- multDRAM rda_multDRAM <- multDRAM
expect_true(RunVignetteChunks("V02.2_param_mcmc")) expect_true(RunVignetteChunks("V02.2_param_mcmc"))
expect_equal(gelRub, rda_gelRub, tolerance = 1E-7) expect_equal(gelRub, rda_gelRub, tolerance = 1e-7)
expect_equal(multDRAM, rda_multDRAM, tolerance = 1E-7) expect_equal(multDRAM, rda_multDRAM, tolerance = 1e-7)
}) })
test_that("V03_param_sets_GR4J works", { test_that("V03_param_sets_GR4J works", {
...@@ -45,8 +45,8 @@ test_that("V04_cemaneige_hysteresis works", { ...@@ -45,8 +45,8 @@ test_that("V04_cemaneige_hysteresis works", {
rda_OutputsCrit_Val_NoHyst <- OutputsCrit_Val_NoHyst rda_OutputsCrit_Val_NoHyst <- OutputsCrit_Val_NoHyst
expect_true(RunVignetteChunks("V04_cemaneige_hysteresis")) expect_true(RunVignetteChunks("V04_cemaneige_hysteresis"))
TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea) TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea)
expect_equal(OutputsCrit_Cal, rda_OutputsCrit_Cal, 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_Cal_NoHyst, rda_OutputsCrit_Cal_NoHyst, tolerance = 1e-7)
expect_equal(OutputsCrit_Val, rda_OutputsCrit_Val, 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_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