Commit cb5a3a4d authored by Delaigue Olivier's avatar Delaigue Olivier

style: add spaces and change '=' sign to '<-' in test functions

parent 153a9062
......@@ -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
......@@ -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)
})
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