diff --git a/tests/testthat/helper_vignettes.R b/tests/testthat/helper_vignettes.R index 53d32a862e414c7d6253a6a2ff65717f9422cdf2..5c7a553239e5e0aa888c2b7ead08c177e8bd4459 100644 --- a/tests/testthat/helper_vignettes.R +++ b/tests/testthat/helper_vignettes.R @@ -7,29 +7,29 @@ RunRmdChunks <- function(fileRmd, tmpFolder = "../tmp", force.eval = TRUE) { dir.create(tmpFolder, showWarnings = FALSE) - output = file.path(tmpFolder, + output <- file.path(tmpFolder, gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE)) knitr::purl(fileRmd, output = output, quiet = TRUE) - sTxt = readLines(output) + sTxt <- readLines(output) if (force.eval) { - sectionLines = grep("^## ----", sTxt) - chunksEvalStart = grep("^## ----.*eval=F", sTxt) + sectionLines <- grep("^## ----", sTxt) + chunksEvalStart <- grep("^## ----.*eval=F", sTxt) if (length(chunksEvalStart) > 0) { if (sectionLines[length(sectionLines)] == chunksEvalStart[length(chunksEvalStart)]) { - lastEvalStart = length(chunksEvalStart) - 1 + lastEvalStart <- length(chunksEvalStart) - 1 } else { - lastEvalStart = length(chunksEvalStart) + lastEvalStart <- length(chunksEvalStart) } # Search for end lines of eval=F chunks - chunksEvalEnd = sectionLines[sapply(chunksEvalStart[1:lastEvalStart], function(x) {which(sectionLines == x)}) + 1] - 1 - if(lastEvalStart) { + chunksEvalEnd <- sectionLines[sapply(chunksEvalStart[1:lastEvalStart], function(x) {which(sectionLines == x)}) + 1] - 1 + if (lastEvalStart) { # Add last line if last chunk is eval=FALSE - chunksEvalEnd = c(chunksEvalEnd, length(sTxt)) + chunksEvalEnd <- c(chunksEvalEnd, length(sTxt)) } - chunksEvalStart = chunksEvalStart + 1 # Chunks begin one line after the section comment + chunksEvalStart <- chunksEvalStart + 1 # Chunks begin one line after the section comment for (i in 1:length(chunksEvalStart)) { # Remove comments on eval=F chunk lines - sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] = gsub(pattern = "^## ", + sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] <- gsub(pattern = "^## ", replace = "", x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]]) } @@ -47,16 +47,16 @@ RunRmdChunks <- function(fileRmd, sTxt <- removeFromGrep("^summary\\(.*\\)$", sTxt) sTxt <- removeFromGrep("^str\\(.*\\)$", sTxt) # Switch echo off for some functions - sTxt = gsub("trace\\s?=\\s?[0-9]+", "trace = 0", sTxt) + sTxt <- gsub("trace\\s?=\\s?[0-9]+", "trace = 0", sTxt) # Add parameters to example calls - exLines = grep("^example\\(.*\\)", sTxt) - sTxt[exLines] = paste0(substr(sTxt[exLines], 1, nchar(sTxt[exLines]) - 1), ", echo = FALSE, verbose = FALSE, ask = FALSE)") + exLines <- grep("^example\\(.*\\)", sTxt) + sTxt[exLines] <- paste0(substr(sTxt[exLines], 1, nchar(sTxt[exLines]) - 1), ", echo = FALSE, verbose = FALSE, ask = FALSE)") # Remove question "Hit <Return> to see next plot" - sTxt = c("par(ask=F)", sTxt) + sTxt <- c("par(ask=F)", sTxt) # Write the transformed script writeLines(sTxt, output) # Silently run the chunks - invisible(capture.output(suppressMessages(suppressWarnings(source(output))), type="output")) + invisible(capture.output(suppressMessages(suppressWarnings(source(output))), type = "output")) return(TRUE) } @@ -69,8 +69,8 @@ RunRmdChunks <- function(fileRmd, #' #' @return TestQmmQlsConversion <- function(BasinObs, BasinArea, tolerance = 1E-7) { - Conversion = BasinArea * 1000^2 / 1000 * 1000 # km2 -> m2, mm -> m and m3 -> L - Conversion = Conversion / 86400 # Day -> seconds - notNA = which(!is.na(BasinObs$Qmm)) - expect_equal(BasinObs$Qmm[notNA] * Conversion, BasinObs$Qls[notNA], tolerance=tolerance) + Conversion <- BasinArea * 1000^2 / 1000 * 1000 # km2 -> m2, mm -> m and m3 -> L + 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/test-vignettes.R b/tests/testthat/test-vignettes.R index 90e892914f4febb24958d23623827ba8c51daff6..cf140c96ed01c6207004b5daa63cecb1be93a8de 100644 --- a/tests/testthat/test-vignettes.R +++ b/tests/testthat/test-vignettes.R @@ -2,7 +2,7 @@ context("Test vignette chunks") test_that("V01_get_started works", { skip_on_cran() - rm(list=ls()) + rm(list = ls()) expect_true(RunRmdChunks("../../vignettes/V01_get_started.Rmd")) TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea) }) @@ -10,31 +10,31 @@ test_that("V01_get_started works", { test_that("V02.1_param_optim works", { skip_on_cran() skip("hydroPSO not working presently") - rm(list=ls()) + rm(list = ls()) expect_true(RunRmdChunks("../../vignettes/V02.1_param_optim.Rmd")) }) test_that("V02.2_param_mcmc works", { skip_on_cran() - rm(list=ls()) + rm(list = ls()) load(system.file("vignettesData/vignetteParamMCMC.rda", package = "airGR")) rda_gelRub <- gelRub rda_multDRAM <- multDRAM expect_true(RunRmdChunks("../../vignettes/V02.2_param_mcmc.Rmd")) - 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", { skip_on_cran() - rm(list=ls()) + rm(list = ls()) expect_true(RunRmdChunks("../../vignettes/V03_param_sets_GR4J.Rmd")) }) test_that("V04_cemaneige_hysteresis works", { skip_on_cran() - rm(list=ls()) + rm(list = ls()) load(system.file("vignettesData/vignetteCNHysteresis.rda", package = "airGR")) rda_OutputsCrit_Cal <- OutputsCrit_Cal rda_OutputsCrit_Cal_NoHyst <- OutputsCrit_Cal_NoHyst @@ -42,8 +42,8 @@ test_that("V04_cemaneige_hysteresis works", { rda_OutputsCrit_Val_NoHyst <- OutputsCrit_Val_NoHyst expect_true(RunRmdChunks("../../vignettes/V04_cemaneige_hysteresis.Rmd")) 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) })