From 66edb42eb93522f41b6a3d8ff5b136a928e4adf5 Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Tue, 21 Apr 2020 20:08:51 +0200
Subject: [PATCH] test: Add tests on vignette results (all tests OK)
- Test if loaded results are identical with chunks with eval=FALSE
- Test if Discharge conversion is OK on inputs
Refs #52
---
tests/testthat/helper_vignettes.R | 16 +++++++++++++++
tests/testthat/test-vignettes.R | 34 +++++++++++++++++++------------
2 files changed, 37 insertions(+), 13 deletions(-)
diff --git a/tests/testthat/helper_vignettes.R b/tests/testthat/helper_vignettes.R
index 1f24851a..53d32a86 100644
--- a/tests/testthat/helper_vignettes.R
+++ b/tests/testthat/helper_vignettes.R
@@ -57,4 +57,20 @@ RunRmdChunks <- function(fileRmd,
writeLines(sTxt, output)
# Silently run the chunks
invisible(capture.output(suppressMessages(suppressWarnings(source(output))), type="output"))
+ return(TRUE)
}
+
+
+#' Test if conversion from Q in mm per day into Q in L/s is good in BasinObs
+#'
+#' @param BasinObs A dataframe containing columns Qmm and Qls
+#' @param BasinArea Area of the basin in km2
+#' @param tolerance See ?all.equal
+#'
+#' @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)
+}
\ No newline at end of file
diff --git a/tests/testthat/test-vignettes.R b/tests/testthat/test-vignettes.R
index 93b51d3d..90e89291 100644
--- a/tests/testthat/test-vignettes.R
+++ b/tests/testthat/test-vignettes.R
@@ -3,39 +3,47 @@ context("Test vignette chunks")
test_that("V01_get_started works", {
skip_on_cran()
rm(list=ls())
- RunRmdChunks("../../vignettes/V01_get_started.Rmd")
- # Test Qmm -> Qls conversion in input
- notNA = which(!is.na(BasinObs$Qmm))
- expect(
- all(abs(BasinObs$Qmm[notNA] * BasinInfo$BasinArea / 86400 * 1E6 - BasinObs$Qls[notNA]) < 1E-7),
- "Error in conversion Qmm -> Qls"
- )
+ expect_true(RunRmdChunks("../../vignettes/V01_get_started.Rmd"))
+ TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea)
})
test_that("V02.1_param_optim works", {
skip_on_cran()
skip("hydroPSO not working presently")
rm(list=ls())
- RunRmdChunks("../../vignettes/V02.1_param_optim.Rmd")
+ expect_true(RunRmdChunks("../../vignettes/V02.1_param_optim.Rmd"))
})
test_that("V02.2_param_mcmc works", {
skip_on_cran()
rm(list=ls())
- RunRmdChunks("../../vignettes/V02.2_param_mcmc.Rmd")
-
+ 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)
})
test_that("V03_param_sets_GR4J works", {
skip_on_cran()
rm(list=ls())
- RunRmdChunks("../../vignettes/V03_param_sets_GR4J.Rmd")
+ expect_true(RunRmdChunks("../../vignettes/V03_param_sets_GR4J.Rmd"))
})
test_that("V04_cemaneige_hysteresis works", {
skip_on_cran()
rm(list=ls())
- RunRmdChunks("../../vignettes/V04_cemaneige_hysteresis.Rmd")
-
+ load(system.file("vignettesData/vignetteCNHysteresis.rda", package = "airGR"))
+ rda_OutputsCrit_Cal <- OutputsCrit_Cal
+ rda_OutputsCrit_Cal_NoHyst <- OutputsCrit_Cal_NoHyst
+ rda_OutputsCrit_Val <- OutputsCrit_Val
+ 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)
})
--
GitLab