Merge branch 'cran-prep' into develop

DESCRIPTION

@@ -1,22 +1,23 @@
 Package: EMJMCMC
 Type: Package
 Title: Flexible Bayesian Nonlinear Model Configuration
-Version: 1.4.4.9039
-Date: 2022-03-06
+Version: 1.4.4.9040
+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"))
   )
 Maintainer: Waldir Leoncio <w.l.netto@medisin.uio.no>
-Description: In the package article <doi:10.1613/jair.1.13047>,
-  we 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.
+Description: Implementation of the software from
+  Hubin, A., Storvik, G., & Frommlet, F. (2021) <doi:10.1613/jair.1.13047>,
+  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.
 License: GPL
 Depends: R (>= 3.4.1), bigmemory
 Imports: glmnet, biglm, hash, BAS, stringi, parallel, methods, speedglm, stats
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Suggests:
     testthat (>= 3.0.0), bindata, clusterGeneration, reshape2
 Config/testthat/edition: 3

NAMESPACE

@@ -6,8 +6,6 @@ export(estimate.bas.glm)
 export(estimate.bas.lm)
 export(estimate.bigm)
 export(estimate.elnet)
-export(estimate.gamma.cpen)
-export(estimate.gamma.cpen_2)
 export(estimate.glm)
 export(estimate.logic.glm)
 export(estimate.logic.lm)

R/estimate.gamma.cpen.R

@@ -1,5 +1,4 @@
 #' @title Estimate gamma cpen
-#' @export
 #' @importFrom stringi stri_replace_all stri_split_fixed stri_count_fixed
 #' @param formula formula
 #' @param data dataset
@@ -41,7 +40,6 @@ estimate.gamma.cpen <- function(formula, data, r = 1.0 / 1000.0, logn = log(1000
 }
 
 #' @title Estimate gamma cpen 2
-#' @export
 #' @inheritParams estimate.gamma.cpen
 estimate.gamma.cpen_2 = function(formula, data,r = 1.0/223.0,logn=log(223.0),relat=c("to23","expi","logi","to35","sini","troot","sigmoid"))
 {

tests/testthat/test-BLR-tutorial.R

@@ -53,16 +53,6 @@ res4G <- LogicRegr(
   p.surv = 0.2, ncores = n_threads, print.freq = 0L
 )
 
-# Bayesian logic regression with the Jeffreys prior
-res4J <- LogicRegr(
-  formula = formula1, data = df, family = "Gaussian", prior = "J",
-  report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.1,
-  p.surv = 0.2, ncores = n_threads, print.freq = 0L
-)
-
-# NULLs are expected because predict = FALSE on LogicRegr
-
-# # print the results for the robust g-prior
 test_that("Results for the G-prior are sensible", {
   for (i in seq_len(nrow(res4G$allposteriors))) {
     expect_gte(res4G$allposteriors[i, 2], 0)
@@ -74,60 +64,65 @@ test_that("Results for the G-prior are sensible", {
   expect_length(res4G, 4L)
 })
 
-# #print the results for the Jeffreys prior
-test_that("Results for the Jeffrey's prior are sensible", {
-  for (i in seq_len(nrow(res4J$allposteriors))) {
-    expect_gte(res4J$allposteriors[i, 2], 0)
-    expect_lte(res4J$allposteriors[i, 2], 1)
-  }
-  expect_gte(res4J$threads.stats[[1]]$post.populi, 0)
-  expect_gt(res4J$threads.stats[[1]]$cterm, -1000)
-  expect_equal(res4J$threads.stats[[1]]$preds, NULL)
-  expect_length(res4J, 4L)
-})
+if (interactive()) {
+  # Bayesian logic regression with the Jeffreys prior
+  res4J <- LogicRegr(
+    formula = formula1, data = df, family = "Gaussian", prior = "J",
+    report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.1,
+    p.surv = 0.2, ncores = n_threads, print.freq = 0L
+  )
+  test_that("Results for the Jeffrey's prior are sensible", {
+    for (i in seq_len(nrow(res4J$allposteriors))) {
+      expect_gte(res4J$allposteriors[i, 2], 0)
+      expect_lte(res4J$allposteriors[i, 2], 1)
+    }
+    expect_gte(res4J$threads.stats[[1]]$post.populi, 0)
+    expect_gt(res4J$threads.stats[[1]]$cterm, -1000)
+    expect_equal(res4J$threads.stats[[1]]$preds, NULL)
+    expect_length(res4J, 4L)
+  })
 
-# simulate Gaussian responses from a model with two-way interactions
-# and an age effect which is an extension of S.4 of the paper
-Xp <- data.frame(X)
-Xp$age <- rpois(sample_size,lambda = 34)
-Xp$Y <- rnorm(
-  n = sample_size,
-  mean = 1 + 0.7 * (Xp$X1 * Xp$X4) + 0.89 * (Xp$X8 * Xp$X11) + 1.43 * (Xp$X5 * Xp$X9) + 2 * Xp$age,
-  sd = 1
-)
-teid  <- sample.int(size = 100, n = sample_size, replace = FALSE)
-test  <- Xp[teid, ]
-train <- Xp[-teid, ]
+  # simulate Gaussian responses from a model with two-way interactions
+  # and an age effect which is an extension of S.4 of the paper
+  Xp <- data.frame(X)
+  Xp$age <- rpois(sample_size,lambda = 34)
+  Xp$Y <- rnorm(
+    n = sample_size,
+    mean = 1 + 0.7 * (Xp$X1 * Xp$X4) + 0.89 * (Xp$X8 * Xp$X11) + 1.43 * (Xp$X5 * Xp$X9) + 2 * Xp$age,
+    sd = 1
+  )
+  teid  <- sample.int(size = 100, n = sample_size, replace = FALSE)
+  test  <- Xp[teid, ]
+  train <- Xp[-teid, ]
 
-# specify the initial formula
-formula1 = as.formula(
-  paste("Y ~ 1 +", paste0(colnames(test)[-c(51, 52)], collapse = "+"))
-)
+  # specify the initial formula
+  formula1 = as.formula(
+    paste("Y ~ 1 +", paste0(colnames(test)[-c(51, 52)], collapse = "+"))
+  )
 
-# specify the link function
-g = function(x) x
+  # 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 = stringi::stri_count_fixed(as.character(formula1)[3],"+"),
-  k.max = 15
-)
+  # specify the parameters of the custom estimator function
+  estimator.args <- list(
+    data = train,
+    n = dim(train)[1],
+    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 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
-)
+  # 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
+  )
 
-if (interactive()) {
   # run the inference of BLR with a non-binary covariate and predicions
   set.seed(4)
   res.alt <- suppressMessages(

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

@@ -1,52 +1,54 @@
-set.seed(265508)
-n_cores <- 1L
-n_row <- 100L
-n_col <- 11L
-n_tot <- n_row * n_col
-X1 <- as.data.frame(
-  array(
-    data = rbinom(n = n_tot, size = 1, prob = runif(n = n_tot)),
-    dim = c(n_row, n_col)
+if (interactive()) {
+  set.seed(265508)
+  n_cores <- 1L
+  n_row <- 100L
+  n_col <- 11L
+  n_tot <- n_row * n_col
+  X1 <- as.data.frame(
+    array(
+      data = rbinom(n = n_tot, size = 1, prob = runif(n = n_tot)),
+      dim = c(n_row, n_col)
+    )
   )
-)
-Y1 <- rnorm(
-  n = n_row,
-  mean = 1 +
-    0.7 * (X1$V1 * X1$V4) +
-    0.8896846 * (X1$V8 * X1$V11) +
-    1.434573 * (X1$V5 * X1$V9),
-  sd = 1
-)
-X1$Y1 <- Y1
+  Y1 <- rnorm(
+    n = n_row,
+    mean = 1 +
+      0.7 * (X1$V1 * X1$V4) +
+      0.8896846 * (X1$V8 * X1$V11) +
+      1.434573 * (X1$V5 * X1$V9),
+    sd = 1
+  )
+  X1$Y1 <- Y1
 
-# specify the initial formula
-formula1 <- as.formula(
-  paste(
-    colnames(X1)[n_col + 1L], "~ 1 +",
-    paste0(colnames(X1)[-c(n_col + 1L)], collapse = "+")
+  # specify the initial formula
+  formula1 <- as.formula(
+    paste(
+      colnames(X1)[n_col + 1L], "~ 1 +",
+      paste0(colnames(X1)[-c(n_col + 1L)], collapse = "+")
+    )
   )
-)
-data.example <- as.data.frame(X1)
+  data.example <- as.data.frame(X1)
 
-# run the inference with robust g prior
-res4G <- EMJMCMC::LogicRegr(
-  formula = formula1, data = data.example, family = "Gaussian", prior = "G",
-  report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.01,
-  p.surv = 0.2, ncores = n_cores, print.freq = 0L
-)
+  # run the inference with robust g prior
+  res4G <- EMJMCMC::LogicRegr(
+    formula = formula1, data = data.example, family = "Gaussian", prior = "G",
+    report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.01,
+    p.surv = 0.2, ncores = n_cores, print.freq = 0L
+  )
 
-# run the inference with Jeffrey's prior
-res4J <- EMJMCMC::LogicRegr(
-  formula = formula1, data = data.example, family = "Gaussian", prior = "J",
-  report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.01,
-  p.surv = 0.2, ncores = n_cores, print.freq = 0L
-)
+  # run the inference with Jeffrey's prior
+  res4J <- EMJMCMC::LogicRegr(
+    formula = formula1, data = data.example, family = "Gaussian", prior = "J",
+    report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.01,
+    p.surv = 0.2, ncores = n_cores, print.freq = 0L
+  )
 
-test_that("LogicRegr output matches version 1.4.3", {
-  obs_4G <- as.numeric(res4G$feat.stat[, 2])
-  obs_4J <- as.numeric(res4J$feat.stat[, 2])
-  expect_equal(ncol(res4G$feat.stat), 2L)
-  expect_equal(ncol(res4G$feat.stat), 2L)
-  expect_true(all(obs_4G >= 0) && all(obs_4G <= 1))
-  expect_true(all(obs_4J >= 0) && all(obs_4J <= 1))
-})
+  test_that("LogicRegr output matches version 1.4.3", {
+    obs_4G <- as.numeric(res4G$feat.stat[, 2])
+    obs_4J <- as.numeric(res4J$feat.stat[, 2])
+    expect_equal(ncol(res4G$feat.stat), 2L)
+    expect_equal(ncol(res4G$feat.stat), 2L)
+    expect_true(all(obs_4G >= 0) && all(obs_4G <= 1))
+    expect_true(all(obs_4J >= 0) && all(obs_4J <= 1))
+  })
+}