Skip to content
GitLab
Commit 97be36bd authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

Merge branch... 

Merge branch '175-correct-vignette-due-to-the-return-of-rmalschains-on-the-cran-repository' into 'master'

Handle hydroPSO exception in vignette tests

See merge request !97
parents f79e8697 700783da
dev 191-speed-up-runmodel_lag-when-it-is-used-alone master CRAN_v1.7.6 CRAN_v1.7.5
2 merge requests!97Handle hydroPSO exception in vignette tests,!88refactor: fix to pass CRAN checks
Pipeline #50987 failed with stages
in 95 minutes and 45 seconds
Hide whitespace changes
Inline Side-by-side
Showing
with 73 additions and 24 deletions
+73 -24
.devcontainer/devcontainer.json
+ 4
− 1
View file @ 97be36bd
......@@ -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()'"
}
.vignettechunkignore 0 → 100644
+ 7
− 0
View file @ 97be36bd
# 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
tests/testthat/helper_vignettes.R
+ 44
− 5
View file @ 97be36bd
......@@ -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)
}
vignettes/V02.1_param_optim.Rmd
+ 18
− 18
View file @ 97be36bd
......@@ -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()
```
......
Supports Markdown
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