fixed #70, added tests to propery recognize list-parameters in multir…

…un-simulations

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: LWFBrook90R
 Title: Simulate Evapotranspiration and Soil Moisture with the SVAT Model LWF-Brook90 
-Version: 0.5.3
+Version: 0.5.4.9000
 Authors@R: c(person("Paul", "Schmidt-Walter", , "paulsw@posteo.de", role = c("aut", "cre"),comment=c(ORCID="0000-0003-2699-0893")),
              person("Volodymyr", "Trotsiuk", , ,role = c("aut"),comment=c(ORCID="0000-0002-8363-656X")),
              person("Klaus", "Hammel", , ,role = c("aut")),

NEWS.md

@@ -1,3 +1,9 @@
+# LWFBrook90R 0.5.4.9000
+
+## Bug fixes
+
+ - fixed problem in parameter replacement multirun-permutations [#65](https://github.com/pschmidtwalter/LWFBrook90R/issues/70)
+
 # LWFBrook90R 0.5.3
 
 ## Bug fixes

R/mrunLWFB90.R

@@ -81,17 +81,19 @@ run_multi_LWFB90 <- function(paramvar,
   # determine list and vector elements in param_b90
   is_ll <- lapply(param_b90, function(x) is.list(x) | length(x) > 1 )
 
-  # which of the columns in paramvar belong to the list-parameters?
+  # which of paramvar's columns belong to the list-parameters?
   param_ll <- sapply(names(param_b90[names(is_ll)[which(is_ll == TRUE)]]),
                      simplify = FALSE,
-                     FUN =  grep,
-                     x = paramvar_nms)
+                     FUN = function(x) {
+                       which(grepl(x,paramvar_nms, fixed = TRUE) &
+                               grepl("[[:digit:].]",paramvar_nms))
+                     })
 
   # determine number of nonzero list entries
   param_ll_len <- length(param_ll[sapply(param_ll, function(x) length(x) > 0)])
 
   # check if all the names of paramvar can be found in param_b90
-  if (param_ll_len > 0L) { #length > 1 includede in paramvar
+  if (param_ll_len > 0L) { #length > 1 included in paramvar
     # remove zeros
     param_ll <- param_ll[sapply(param_ll, function(x) length(x) > 0)]
     singlepar_nms <- paramvar_nms[-unlist(param_ll)]
@@ -101,6 +103,7 @@ run_multi_LWFB90 <- function(paramvar,
     nms <- paramvar_nms
   }
 
+
   if (!all(nms %in% names(param_b90))) {
     stop( paste( "Not all names of 'paramvar' were found in 'param_b90'! Check names:",
                  paste(nms[which(!nms %in% names(param_b90))], collapse =", ") ))

tests/testthat/test-multirun.R

@@ -0,0 +1,53 @@
+library(LWFBrook90R)
+library(data.table)
+data("slb1_soil")
+data("slb1_meteo")
+
+if (parallelly::availableCores() > 1) {
+  cores <- 2
+} else {
+  cores <- 1
+}
+
+soil <- cbind(slb1_soil, hydpar_wessolek_tab(texture = slb1_soil$texture))
+soil_lay_mat <- soil_to_param(soil)
+
+opts <- set_optionsLWFB90(startdate = as.Date("2002-12-15"), enddate = as.Date("2003-01-15"))
+parms <- set_paramLWFB90(sai = c(0.5,1.2),maxlai = c(2,5),
+                         soil_nodes = soil_lay_mat$soil_nodes,
+                         soil_materials = soil_lay_mat$soil_materials)
+
+
+vary_parms <- data.frame(maxlai = c(0.941, 0.952),
+                         sai2 = c(0.951, 0.952),
+                         fsintlai = c(0.961,0.962),
+                         frintsai = c(0.971, 0.972),
+                         fsintsai = c(0.981, 0.982),
+                         soil_materials.ths2 = c(0.991,0.992))
+
+res_multi <- run_multi_LWFB90(paramvar = vary_parms[1:N,],
+                              param_b90 = parms,
+                              options_b90 = opts,
+                              climate = slb1_meteo)
+
+
+used_singleparms = rbindlist(
+  lapply(res_multi, function(x) {
+    x$model_input$param_b90[c("fsintlai","frintsai", "fsintsai" )]
+  }))
+
+used_annual_vegparms = rbindlist(lapply(res_multi, function(x) {
+  x$model_input$param_b90[c("maxlai", "sai")]
+}), idcol="No.")
+
+used_listparms = unlist(lapply(res_multi, function(x) {
+  x$model_input$param_b90$soil_materials$ths[2]
+}), use.names = FALSE)
+
+setDT(vary_parms)
+test_that("multi-run: all vary_parms at the right place",{
+  expect_equal(used_singleparms,vary_parms[,names(used_singleparms), with = F])
+  expect_equal(used_annual_vegparms$maxlai, rep(vary_parms$maxlai, each = 2))
+  expect_equal(used_annual_vegparms$sai[c(2,4)], vary_parms$sai2)
+  expect_equal(used_listparms, vary_parms$soil_materials.ths2)
+})