tests: add vignettechunkignore feature

For handling hydroPSO exception on V02

Refs #175

.vignettechunkignore

+# This file is used by the script tests/testthat/test-vignettes which test all
+# chunks including those with `eval=FALSE`
+# It serves to ignore chunks that should not be tested anyway
+# Format: `path to the vignette`[space]`id of the chunk`
+vignettes/V02.1_param_optim.Rmd hydroPSO1
+vignettes/V02.1_param_optim.Rmd hydroPSO2

tests/testthat/helper_vignettes.R

@@ -5,7 +5,8 @@
 #' @param force.eval Force execution of chunks with parameter eval=FALSE
 RunRmdChunks <- function(fileRmd,
                          tmpFolder = "../tmp",
-                         force.eval = TRUE) {
+                         force.eval = TRUE,
+                         chunkIgnore = getChunkIgnore()) {
   dir.create(tmpFolder, showWarnings = FALSE)
   output <- file.path(tmpFolder,
                       gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE))
@@ -13,7 +14,13 @@ RunRmdChunks <- function(fileRmd,
   sTxt <- readLines(output)
   if (force.eval) {
     sectionLines <- grep("^## ----", sTxt)
-    chunksEvalStart <- grep("^## ----.*eval=F", sTxt)
+    chunkIgnore <- chunkIgnore[[fileRmd]]
+    if (!is.null(chunkIgnore)) {
+      regexChunk <- sprintf("(?!(%s))", paste(chunkIgnore, collapse = "|"))
+    } else {
+      regexChunk <- ""
+    }
+    chunksEvalStart <- grep(paste0("^## ----", regexChunk, ".*eval=F"), sTxt, ignore.case=TRUE, perl = TRUE)
     if (length(chunksEvalStart) > 0) {
       if (sectionLines[length(sectionLines)] == chunksEvalStart[length(chunksEvalStart)]) {
         lastEvalStart <- length(chunksEvalStart) - 1
@@ -69,16 +76,26 @@ RunRmdChunks <- function(fileRmd,
 #' @return TRUE if succeed.
 RunVignetteChunks <- function(vignette,
                               tmpFolder = "../tmp",
-                              force.eval = TRUE) {
+                              force.eval = TRUE,
+                              chunkIgnore = getChunkIgnore()) {
   if (file.exists(sprintf("../../vignettes/%s.Rmd", vignette))) {
     # testthat context in development environnement
-    RunRmdChunks(sprintf("../../vignettes/%s.Rmd", vignette), tmpFolder, force.eval)
+    RunRmdChunks(sprintf("../../vignettes/%s.Rmd", vignette),
+                 tmpFolder = tmpFolder,
+                 force.eval =force.eval,
+                 chunkIgnore = chunkIgnore)
   } else if (file.exists(sprintf("vignettes/%s.Rmd", vignette))) {
     # context in direct run in development environnement
-    RunRmdChunks(sprintf("vignettes/%s.Rmd", vignette), tmpFolder, force.eval)
+    RunRmdChunks(sprintf("vignettes/%s.Rmd", vignette),
+                 tmpFolder = tmpFolder,
+                 force.eval =force.eval,
+                 chunkIgnore = chunkIgnore)
   } else {
     # R CMD check context in package environnement
-    RunRmdChunks(system.file(sprintf("doc/%s.Rmd", vignette), package = "airGR"), tmpFolder, force.eval)
+    RunRmdChunks(system.file(sprintf("doc/%s.Rmd", vignette), package = "airGR"),
+                 tmpFolder = tmpFolder,
+                 force.eval =force.eval,
+                 chunkIgnore = chunkIgnore)
   }
   return(TRUE)
 }
@@ -96,3 +113,24 @@ TestQmmQlsConversion <- function(BasinObs, BasinArea, tolerance = 1E-7) {
   notNA <- which(!is.na(BasinObs$Qmm))
   expect_equal(BasinObs$Qmm[notNA] * Conversion, BasinObs$Qls[notNA], tolerance = tolerance)
 }
+
+#' Read vignettechunkignore file
+#'
+#' @param chunkIgnoreFile path to the file
+#'
+#' @return [list] with one item by vignette containing the chunk id to ignore
+#'
+getChunkIgnore <- function(chunkIgnoreFile = "../../.vignettechunkignore") {
+  if (file.exists(chunkIgnoreFile)) {
+    chunkIgnore <- read.table(file = chunkIgnoreFile,
+                              sep = " ", header = FALSE,
+                              col.names = c("vignette", "chunk"),
+                              stringsAsFactors = FALSE)
+    chunkIgnore <- lapply(setNames(nm = unique(chunkIgnore$vignette)), function(x) {
+      chunkIgnore$chunk[chunkIgnore$vignette == x]
+    })
+  } else {
+    chunkIgnore <- list()
+  }
+  return(chunkIgnore)
+}

vignettes/V02.1_param_optim.Rmd

@@ -10,7 +10,7 @@ vignette: >
 
 
 
-```{r, warning=FALSE, include=FALSE, fig.keep='none', results='hide'}
+```{r setup, warning=FALSE, include=FALSE, fig.keep='none', results='hide'}
 library(airGR)
 library(DEoptim)
 # library(hydroPSO) # Needs R version >= 3.6 or latticeExtra <= 0.6-28 on R 3.5. Archived on 2023-10-16 as requires archived packages 'hydroTSM' and 'hydroGOF'. 
@@ -41,13 +41,13 @@ Please note that the calibration period is defined in the `CreateRunOptions()` f
 <!-- example("Calibration_Michel", echo = FALSE, ask = FALSE) -->
 <!-- ``` -->
 
-```{r, echo=TRUE, eval=FALSE}
+```{r Calibration_Michel, echo=TRUE, eval=FALSE}
 example("Calibration_Michel")
 ```
 
 In order for the `RunModel_*()` functions to run faster during the parameter estimation process, it is recommended that the outputs contain only the simulated flows (see the `Outputs_Sim` argument in the `CreateRunOptions()` help page).
 
-```{r, results='hide', eval=FALSE}
+```{r RunOptions, results='hide', eval=FALSE}
 RunOptions <- airGR::CreateRunOptions(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel,
                                       IndPeriod_Run = Ind_Run,
                                       Outputs_Sim = "Qsim")
@@ -66,7 +66,7 @@ Here we choose to minimize the root mean square error.
 
 The change of the repository from the "real" parameter space to a "transformed" space ensures homogeneity of displacement in the different dimensions of the parameter space during the step-by-step procedure of the calibration algorithm of the model.
 
-```{r, warning=FALSE, results='hide', eval=FALSE}
+```{r OptimGR4J, warning=FALSE, results='hide', eval=FALSE}
 OptimGR4J <- function(ParamOptim) {
   ## Transformation of the parameter set to real space
   RawParamOptim <- airGR::TransfoParam_GR4J(ParamIn = ParamOptim,
@@ -86,7 +86,7 @@ OptimGR4J <- function(ParamOptim) {
 
 In addition, we need to define the lower and upper bounds of the four **GR4J** parameters in the transformed parameter space:
 
-```{r, warning=FALSE, results='hide', eval=FALSE}
+```{r boundsGR4J, warning=FALSE, results='hide', eval=FALSE}
 lowerGR4J <- rep(-9.99, times = 4)
 upperGR4J <- rep(+9.99, times = 4)
 ```
@@ -97,7 +97,7 @@ upperGR4J <- rep(+9.99, times = 4)
 
 We start with a local optimization strategy by using the PORT routines (using the `nlminb()` of the `stats` package) and by setting a starting point in the transformed parameter space:
 
-```{r, warning=FALSE, results='hide', eval=FALSE}
+```{r local1, warning=FALSE, results='hide', eval=FALSE}
 startGR4J <- c(4.1, 3.9, -0.9, -8.7)
 optPORT <- stats::nlminb(start = startGR4J,
                          objective = OptimGR4J,
@@ -111,7 +111,7 @@ We can also try a multi-start approach to test the consistency of the local opti
 Here we use the same grid used for the filtering step of the Michel's calibration strategy (`Calibration_Michel()` function).
 For each starting point, a local optimization is performed.
 
-```{r, warning=FALSE, results='hide', eval=FALSE}
+```{r local2, warning=FALSE, results='hide', eval=FALSE}
 startGR4JDistrib <- TransfoParam_GR4J(ParamIn = CalibOptions$StartParamDistrib,
                                       Direction = "RT")
 startGR4J <- expand.grid(data.frame(startGR4JDistrib))
@@ -126,7 +126,7 @@ listOptPORT <- apply(startGR4J, MARGIN = 1, FUN = optPORT_)
 
 We can then extract the best parameter sets and the value of the performance criteria:
 
-```{r, warning=FALSE, results='hide', eval=FALSE}
+```{r local3, warning=FALSE, results='hide', eval=FALSE}
 parPORT <- t(sapply(listOptPORT, function(x) x$par))
 objPORT <- sapply(listOptPORT, function(x) x$objective)
 resPORT <- data.frame(parPORT, RMSE = objPORT)
@@ -134,7 +134,7 @@ resPORT <- data.frame(parPORT, RMSE = objPORT)
 
 As can be seen below, the optimum performance criterion values (column *objective*) can differ from the global optimum value in many cases, resulting in various parameter sets.
 
-```{r, warning=FALSE}
+```{r local4, warning=FALSE}
 summary(resPORT)
 ```
 
@@ -154,7 +154,7 @@ Here we use the following R implementation of some popular strategies:
 
 ## Differential Evolution
 
-```{r, warning=FALSE, results='hide', eval=FALSE}
+```{r optDE, warning=FALSE, results='hide', eval=FALSE}
 optDE <- DEoptim::DEoptim(fn = OptimGR4J,
                           lower = lowerGR4J, upper = upperGR4J,
                           control = DEoptim::DEoptim.control(NP = 40, trace = 10))
@@ -163,7 +163,7 @@ optDE <- DEoptim::DEoptim(fn = OptimGR4J,
 
 ## Particle Swarm
 
-```{r, warning=FALSE, results='hide', message=FALSE, eval=FALSE}
+```{r hydroPSO1, warning=FALSE, results='hide', message=FALSE, eval=FALSE}
 # to install the package temporary removed from CRAN
 # Rtools needed (windows : https://cran.r-project.org/bin/windows/Rtools/)
 # install.packages("https://cran.r-project.org/src/contrib/Archive/hydroPSO/hydroPSO_0.5-1.tar.gz", 
@@ -171,7 +171,7 @@ optDE <- DEoptim::DEoptim(fn = OptimGR4J,
 ```
 
 
-```{r, warning=FALSE, results='hide', message=FALSE, eval=FALSE}
+```{r hydroPSO2, warning=FALSE, results='hide', message=FALSE, eval=FALSE}
 optPSO <- hydroPSO::hydroPSO(fn = OptimGR4J,
                              lower = lowerGR4J, upper = upperGR4J,
                              control = list(write2disk = FALSE, verbose = FALSE))