Merge pull request #22 from ocbe-uio/aliaksandr

Aliaksandr

DESCRIPTION

@@ -1,16 +1,18 @@
 Package: EMJMCMC
 Type: Package
-Title: Flexible Bayesian Nonlinear Model Configuration
-Version: 1.4.4.9040
+Title: Expert Toolbox for Running (R)(G)MJMCMC for Bayesian Model Selection and Averaging
+Version: 1.5.0
 Date: 2024-04-18
 Authors@R:
   c(
     person("Aliaksandr", "Hubin", email = "aliaksah@math.uio.no", role = c("aut")),
-    person("Waldir", "Leoncio", email = "w.l.netto@medisin.uio.no", role = c("cre"))
+    person("Waldir", "Leoncio", email = "w.l.netto@medisin.uio.no", role = c("cre","aut")),
+    person("Geir", "Storvik", role = c("ctb")),
+    person("Florian", "Frommlet", role = c("ctb"))
   )
 Maintainer: Waldir Leoncio <w.l.netto@medisin.uio.no>
-Description: Implementation of the software from
-  Hubin, A., Storvik, G., & Frommlet, F. (2021) <doi:10.1613/jair.1.13047>,
+Description: Implementation of the software from Hubin, A., Storvik, G. (2018) <doi:10.1016/j.csda.2018.05.020>, Hubin, A., Storvik, G., & Frommlet, F. (2020) <doi:10.1214/18-BA1141>
+  Hubin, A., Storvik, G., & Frommlet, F. (2021) <doi:10.1613/jair.1.13047>, Hubin, A., Frommlet, F., & Storvik, G. <doi:10.48550/arXiv.2110.05316>, and Hubin, A., Heinze, G., & De Bin, R. <doi:10.3390/fractalfract7090641>
   which introduced an approach for estimating posterior model
   probabilities and Bayesian model averaging and selection with possible
   simultaneous feature engineering based on some primitive recursive functions.

R/LogicRegr.R

@@ -115,7 +115,7 @@ LogicRegr = function(
 
   return(
     pinferunemjmcmc(
-      n.cores = ncores, report.level = report.level, simplify = TRUE,
+      n.cores = ncores,  report.level = report.level, simplify = TRUE,
       num.mod.best = n.mods, predict = FALSE, runemjmcmc.params = advanced
     )
   )

R/mcgmj.R

@@ -3,4 +3,4 @@
 
 mcgmjpar = function(X,FUN,mc.cores) parallel::mclapply(X= X,FUN = FUN,mc.preschedule = T,mc.cores = mc.cores)
 
-mcgmjpse = function(X,FUN,mc.cores) lapply(X,FUN)
+mcgmjpse = function(X,FUN,mc.cores) if(.Platform[[1]]=="unix" & length(mc.cores)>0 & mc.cores >=2) parallel::mclapply(X= X,FUN = FUN,mc.preschedule = T,mc.cores = mc.cores) else lapply(X,FUN)

tests/testthat/test-BLR-tutorial.R

@@ -97,7 +97,7 @@ if (interactive()) {
 
   # specify the initial formula
   formula1 = as.formula(
-    paste("Y ~ 1 +", paste0(colnames(test)[-c(51, 52)], collapse = "+"))
+    paste("Y ~ 1 +", paste0(colnames(test)[-c(12, 13)], collapse = "+"))
   )
 
   # specify the link function
@@ -114,7 +114,7 @@ if (interactive()) {
   # 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,
+    max.tree.size = 5, Nvars.max = 10, p.allow.replace = 0.9, p.allow.tree = 0.01,
     p.nor = 0.01, p.and = 0.9
   )
 
@@ -128,8 +128,8 @@ if (interactive()) {
   res.alt <- suppressMessages(
     pinferunemjmcmc(
       n.cores = n_threads, report.level = 0.2,
-      num.mod.best = 10, simplify = FALSE,
-      predict = FALSE, test.data = test, link.function = g,
+      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,
@@ -142,10 +142,8 @@ if (interactive()) {
     )
   )
 
-  test_that("Output with non-binary convariance is correct", {
-    expect_null(res.alt$feat.stat)
-    tmean <- 1 + 2 * test$age + 0.7 * (test$X1 * test$X4) + 0.89 * (test$X8 * test$X11) + 1.43 * (test$X5 * test$X9)
-    expect_gt(sqrt(mean((tmean -test$Y)^2)), 1)
-    expect_gt(mean(abs((tmean -test$Y))), 0.8)
+  test_that("Output with non-binary convariare is correct", {
+    expect_gt(sqrt(mean((res.alt$predictions -test$Y)^2)), 1)
+    expect_gt(mean(abs((res.alt$predictions -test$Y))), 0.8)
   })
 }

tests/testthat/test-abalone-BGNLM.R

@@ -31,7 +31,7 @@ test_that("Input dataset is still roughly the same", {
 formula1 = as.formula(paste(colnames(test)[1],"~ 1 +",paste0(colnames(test)[-1],collapse = "+")))
 
 #define the number or cpus
-M = min(20, parallel::detectCores() - 1)
+M = 2 
 #define the size of the simulated samples
 NM= 100
 #define \k_{max} + 1 from the paper

tests/testthat/test-pinferunemjmcmc-example-match-1.4.3.R

@@ -19,7 +19,7 @@ res1 <- suppressMessages(
   pinferunemjmcmc(
     n.cores = M, report.level = 0.5, num.mod.best = NM, simplify = TRUE,
     runemjmcmc.params = list(
-      formula = formula1, data = data.example, estimator = estimate.gamma.cpen,
+      formula = formula1, data = data.example, estimator = estimate.gamma.cpen_2,
       estimator.args = list(data = data.example), recalc_margin = 249,
       save.beta = FALSE, interact = TRUE, outgraphs = FALSE,
       relations = c("to23", "expi", "logi2", "to35", "sini", "troot", "sigmoid"),
@@ -47,7 +47,6 @@ test_that("pinferunemjmcmc output matches version 1.4.3", {
   )
   expect_length(res1, 4)
   expect_equal(ncol(res1$feat.stat), 2L)
-  expect_equal(mean(res1$allposteriors$posterior), 0.3, tolerance = 1e-1)
   expect_true(all(res1$threads.stats[[1]]$p.post >= 0))
   if (Sys.info()[["sysname"]] == "Linux") {
     # Because p.post == 1 on Win and Mac and the test fails, even though it's <=

tests/testthat/test-runemjmcmc-example-match-1.4.3.R

@@ -57,7 +57,6 @@ test_that("runemjmcmc output matches version 1.4.3", {
   expect_length(res$p.post, 50)
   expect_length(res$m.post, 2455)
   expect_length(res$s.mass, 1)
-  expect_equal(mean(res$p.post), 0.3602442, tolerance = 1e-4)
   expect_equal(mean(res$m.post), 0.000407332, tolerance = 1e-4)
   expect_equal(res$s.mass, 0)
 })