Merge branch 'issue-17' into develop

* issue-17:
  Increment version number to 1.4.4.9033
  Wrapped long test in `if(interactive())` (#17)
  Fix docs
  Updated unit test expectations (#17)
  Streamlining BLR tutorial (#17)

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: EMJMCMC
 Type: Package
 Title: Flexible Bayesian Nonlinear Model Configuration
-Version: 1.4.4.9032
+Version: 1.4.4.9033
 Date: 2022-03-06
 Authors@R:
   c(

R/runemjmcmc.R

@@ -28,7 +28,7 @@
 #' @param interact a boolean parameter defining if feature engineering is allowed in the search
 #' @param relations a vector of allowed modification functions (only relevant when feature engineering is enabled by means of interact = T)
 #' @param relations.prob probability distribution of addressing modifications defined in relations parameter (both vectors must be of the same length)
-#' @param gen.prob a vector of probabilities for different operators in GMJMCMC or RGMJMCMC in the deep regression context (hence only relevant if interact.param\$allow_offsprings is either 3 or 4)
+#' @param gen.prob a vector of probabilities for different operators in GMJMCMC or RGMJMCMC in the deep regression context (hence only relevant if \code{interact.param$allow_offsprings} is either 3 or 4)
 #' @param pool.cross a parameter defining the probability of adressing covariates from the current pool of covariates in GMJMCMC (covariates from the set of filtered covariates can be addressed with probability 1-pool.cross) (only relevant when interact = TRUE)
 #' @param p.add a default marginal inclusion probability parameter to be changed during the search to the true value
 #' @param p.add.default a parameter defining sparcity after filtrations in gmjmcmc as initial marginal inclusion probabilities vector for paramters in the current pool

tests/testthat/test-BLR-tutorial.R

@@ -99,53 +99,70 @@ train <- Xp[-teid, ]
 formula1 = as.formula(
   paste("Y ~ 1 +", paste0(colnames(test)[-c(51, 52)], collapse = "+"))
 )
+
 # specify the link function
 g = function(x) x
+
 # specify the parameters of the custom estimator function
 estimator.args <- list(
   data = train,
   n = dim(train)[1],
-  m = stri_count_fixed(as.character(formula1)[3],"+"),
+  m = stringi::stri_count_fixed(as.character(formula1)[3],"+"),
   k.max = 15
 )
+
 # specify the parameters of gmjmcmc algorithm
 gmjmcmc.params <- list(
   allow_offsprings = 1, mutation_rate = 250, last.mutation = 10000,
   max.tree.size = 5, Nvars.max = 15, p.allow.replace = 0.9, p.allow.tree = 0.01,
   p.nor = 0.01, p.and = 0.9
 )
+
 # specify some advenced parameters of mjmcmc
 mjmcmc.params <- list(
   max.N.glob = 10, min.N.glob = 5, max.N = 3, min.N = 1, printable = FALSE
 )
-# run the inference of BLR with a non-binary covariate and predicions
-res.alt <- pinferunemjmcmc(
-  n.cores = 30, report.level = 0.2, num.mod.best = 100, simplify = TRUE,
-  predict = TRUE, test.data = test, link.function = g,
-  runemjmcmc.params = list(
-    formula = formula1,latnames = c("I(age)"), data = train,
-    estimator = estimate.logic.lm.jef, estimator.args = estimator.args,
-    recalc_margin = 249, save.beta = TRUE, interact = TRUE, outgraphs = FALSE,
-    interact.param = gmjmcmc.params, n.models = 10000, unique = FALSE,
-    max.cpu = 4, max.cpu.glob = 4, create.table = FALSE, create.hash = TRUE,
-    pseudo.paral = TRUE, burn.in = 100, print.freq = 1000,
-    advanced.param = mjmcmc.params
-  )
-)
 
-test_that("Output with non-binary convariance is correct", {
-  expect_equal(
-    res.alt$feat.stat[, 1],
-    c("I(age)", "I(((X5))&((X9)))", "I(((X8))&((X11)))", "I(X4)", "I(X1)")
-  )
-  expect_equal(
-    res.alt$feat.stat[, 2],
-    c("1", "0.999999999999968", "0.999999999999968", "0.999982534893339", "0.999948879594117")
-  )
-  expect_equal(
-    sqrt(mean((res.alt$predictions-test$Y)^2)), 1.030494, tolerance = 1e-6
+if (interactive()) {
+  # run the inference of BLR with a non-binary covariate and predicions
+  set.seed(4)
+  res.alt <- suppressMessages(
+    pinferunemjmcmc(
+      n.cores = min(20, parallel::detectCores() - 1), report.level = 0.2,
+      num.mod.best = 10, simplify = TRUE,
+      predict = TRUE, test.data = test, link.function = g,
+      runemjmcmc.params = list(
+        formula = formula1, latnames = c("I(age)"), data = train,
+        estimator = estimate.logic.lm.jef, estimator.args = estimator.args,
+        recalc_margin = 249, save.beta = TRUE, interact = TRUE, outgraphs = FALSE,
+        interact.param = gmjmcmc.params, n.models = 10000, unique = FALSE,
+        max.cpu = 4, max.cpu.glob = 4, create.table = FALSE, create.hash = TRUE,
+        pseudo.paral = FALSE, burn.in = 1000, print.freq = 0,
+        advanced.param = mjmcmc.params
+      )
+    )
   )
-  tmean <- 1 + 2 * test$age + 0.7 * (test$X1 * test$X4) + 0.89 * (test$X8 * test$X11) + 1.43 * (test$X5 * test$X9)
-  expect_equal(sqrt(mean((tmean -test$Y)^2)), .9839559, tolerance = 1e-6)
-  expect_equal(mean(abs((tmean -test$Y))), .8127523, tolerance = 1e-6)
-})
+
+  test_that("Output with non-binary convariance is correct", {
+    expect_equal(
+      res.alt$feat.stat[, 1],
+      c(
+        "I(age)", "I(X5)", "I(X8)", "I(X1)", "I(((X9))&((X11)))", "I(X9)",
+        "I(X4)"
+      )
+    )
+    expect_equal(
+      res.alt$feat.stat[, 2],
+      c(
+        "1", "0.999999994807055", "0.999956729898551", "0.999577926669365",
+        "0.98582433936886", "0.98377325490383", "0.934544180132695"
+      )
+    )
+    expect_equal(
+      sqrt(mean((res.alt$predictions - test$Y) ^ 2)), 1.184527, tolerance = 1e-6
+    )
+    tmean <- 1 + 2 * test$age + 0.7 * (test$X1 * test$X4) + 0.89 * (test$X8 * test$X11) + 1.43 * (test$X5 * test$X9)
+    expect_equal(sqrt(mean((tmean -test$Y)^2)), 1.06036, tolerance = 1e-6)
+    expect_equal(mean(abs((tmean -test$Y))), .8067262, tolerance = 1e-6)
+  })
+}