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

@@ -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

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)
 })