diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
index 11cd7e6ab387b848c948b030e319198340ef66a1..862db2e8601d1574ca0995297a017dc7cd03e192 100644
--- a/.devcontainer/devcontainer.json
+++ b/.devcontainer/devcontainer.json
@@ -7,5 +7,8 @@
"REditorSupport.r"
]
}
- }
+ },
+ // Use 'postCreateCommand' to run commands after the container is created.
+ "postCreateCommand": "R -q -e 'install.packages(\"languageserver\");remotes::install_deps(dep = TRUE)'",
+ "postStartCommand": "R -q -e 'devtools::install()'"
}
diff --git a/.vignettechunkignore b/.vignettechunkignore
new file mode 100644
index 0000000000000000000000000000000000000000..fc31c8f750cc9f4cfa1f37584f0fec48adbdaa09
--- /dev/null
+++ b/.vignettechunkignore
@@ -0,0 +1,7 @@
+# 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: `vignette file name`[space]`id of the chunk`
+V02.1_param_optim.Rmd hydroPSO1
+V02.1_param_optim.Rmd hydroPSO2
+V02.1_param_optim.Rmd resGLOB
diff --git a/tests/testthat/helper_vignettes.R b/tests/testthat/helper_vignettes.R
index 98951fef380002bc1243e705ceaf2ac5c5d124a1..ace7650cb7510eaa7117e2a654e727612e2af388 100644
--- a/tests/testthat/helper_vignettes.R
+++ b/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[[basename(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
@@ -72,13 +79,22 @@ RunVignetteChunks <- function(vignette,
force.eval = TRUE) {
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 = getChunkIgnore("../../.vignettechunkignore"))
} 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 = getChunkIgnore(".vignettechunkignore"))
} 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 = getChunkIgnore(".vignettechunkignore"))
}
return(TRUE)
}
@@ -96,3 +112,26 @@ 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)) {
+ message(".vignettechunkignore file found")
+ 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 {
+ message("No .vignettechunkignore file found")
+ chunkIgnore <- list()
+ }
+ return(chunkIgnore)
+}
diff --git a/vignettes/V02.1_param_optim.Rmd b/vignettes/V02.1_param_optim.Rmd
index 6c43ac8583b48f02e5ccf2766e80abdad8a8a422..d0185b731b451d39127aa55837995cf0baa73cdd 100644
--- a/vignettes/V02.1_param_optim.Rmd
+++ b/vignettes/V02.1_param_optim.Rmd
@@ -10,10 +10,10 @@ 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'.
+# 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'.
library(Rmalschains)
library(caRamel)
library(ggplot2)
@@ -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,15 +163,15 @@ 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",
+# install.packages("https://cran.r-project.org/src/contrib/Archive/hydroPSO/hydroPSO_0.5-1.tar.gz",
# repos = NULL, type = "source", dependencies = TRUE)
```
-```{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))
@@ -192,7 +192,7 @@ optMALS <- Rmalschains::malschains(fn = OptimGR4J,
As it can be seen in the table below, the four additional optimization strategies tested lead to very close optima.
-```{r, warning=FALSE, echo=FALSE, eval=FALSE}
+```{r resGLOB, warning=FALSE, echo=FALSE, eval=FALSE}
resGLOB <- data.frame(Algo = c("airGR", "PORT", "DE", "PSO", "MA-LS"),
round(rbind(
OutputsCalib$ParamFinalR,
@@ -223,7 +223,7 @@ First, the OptimGR4J function previously used is modified to return two values.
```{r, warning=FALSE, results='hide', eval=FALSE}
InputsCrit_inv <- InputsCrit
InputsCrit_inv$transfo <- "inv"
-
+
MOptimGR4J <- function(i) {
if (algo == "caRamel") {
ParamOptim <- x[i, ]
@@ -270,9 +270,9 @@ optMO <- caRamel::caRamel(nobj = 2,
The algorithm returns parameter sets that describe the pareto front, illustrating the trade-off between overall good performance and good performance for low flow.
```{r, fig.width=6, fig.height=6, warning=FALSE}
-ggplot() +
+ggplot() +
geom_point(aes(optMO$objectives[, 1], optMO$objectives[, 2])) +
- coord_equal(xlim = c(0.4, 0.9), ylim = c(0.4, 0.9)) +
+ coord_equal(xlim = c(0.4, 0.9), ylim = c(0.4, 0.9)) +
xlab("KGE") + ylab("KGE [1/Q]") +
theme_bw()
```