Merge branch 'issue-19' into develop

* issue-19:
  Removed TODO (it's now issue #20)
  Simplified tests
  Suppressing output of tests

R/g.R

@@ -1 +1 @@
-g <- function(x) x # TODO: check with Aliaksandr if this should be the package default
+g <- function(x) x

R/pinferunemjmcmc.R

@@ -175,7 +175,8 @@ pinferunemjmcmc = function(
   return(
     list(
       feat.stat = cbind(res1$feature, res1$posterior),
-      predictions = pred,allposteriors = posteriors,
+      predictions = pred,
+      allposteriors = posteriors,
       threads.stats = results
     )
   )

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

@@ -32,14 +32,14 @@ data.example <- as.data.frame(X1)
 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
+  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
+  p.surv = 0.2, ncores = n_cores, print.freq = 0L
 )
 
 test_that("LogicRegr output matches version 1.4.3", {

tests/testthat/test-inference-help.R

@@ -1,80 +1,82 @@
-# simulate Gaussian responses
-threads <- 1L
-n_dims <- c(11, 100)
-set.seed(040590)
-X1 <- as.data.frame(
-  array(
-    data = rbinom(n = prod(n_dims), size = 1, prob = runif(n = prod(n_dims), 0, 1)),
-    dim = rev(n_dims)
+if (interactive()) {
+  # simulate Gaussian responses
+  threads <- 1L
+  n_dims <- c(100L, 11L)
+  set.seed(040590)
+  X1 <- as.data.frame(
+    array(
+      data = rbinom(n = prod(n_dims), size = 1, prob = runif(n = prod(n_dims), 0, 1)),
+      dim = n_dims
+    )
+  )
+  Y1 <- rnorm(
+    n = n_dims[1],
+    mean = 1 + 0.7 * (X1$V1 * X1$V4) + 0.8896846 * (X1$V8 * X1$V11) + 1.434573 * (X1$V5 * X1$V9),
+    sd = 1
   )
-)
-Y1 <- rnorm(
-  n = n_dims[2],
-  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
+  X1$Y1 <- Y1
 
-# specify the initial formula
-formula1 <- as.formula(
-  paste(colnames(X1)[ncol(X1)], "~ 1 +", paste0(colnames(X1)[-c(ncol(X1))], collapse = "+"))
-)
-data.example <- as.data.frame(X1)
+  # specify the initial formula
+  formula1 <- as.formula(
+    paste(colnames(X1)[ncol(X1)], "~ 1 +", paste0(colnames(X1)[-c(ncol(X1))], collapse = "+"))
+  )
+  data.example <- as.data.frame(X1)
 
-# run the inference with robust g prior
-res4G <- suppressMessages(
-  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 = threads, print.freq = 0L
+  # run the inference with robust g prior
+  res4G <- suppressMessages(
+    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 = threads, print.freq = 0L
+    )
   )
-)
-# run the inference with Jeffrey's prior
-res4J <- suppressMessages(
-  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 = threads, print.freq = 0L
+  # run the inference with Jeffrey's prior
+  res4J <- suppressMessages(
+    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 = threads, print.freq = 0L
+    )
   )
-)
 
-# change to Bernoulli responses
-X1 <- as.data.frame(
-  array(data = rbinom(n = prod(n_dims), size = 1, prob = 0.3), dim = rev(n_dims))
-)
-Y1 <- -0.7 + 1 * ((1 - X1$V1) * (X1$V4)) + 1 * (X1$V8 * X1$V11) + 1 * (X1$V5 * X1$V9)
-X1$Y1 <- round(1.0 / (1.0 + exp(-Y1)))
+  # change to Bernoulli responses
+  X1 <- as.data.frame(
+    array(data = rbinom(n = prod(n_dims), size = 1, prob = 0.3), dim = n_dims)
+  )
+  Y1 <- -0.7 + 1 * ((1 - X1$V1) * (X1$V4)) + 1 * (X1$V8 * X1$V11) + 1 * (X1$V5 * X1$V9)
+  X1$Y1 <- round(1.0 / (1.0 + exp(-Y1)))
 
-# specify the initial formula
-formula1 <- as.formula(
-  paste(colnames(X1)[ncol(X1)], "~ 1 +", paste0(colnames(X1)[-c(ncol(X1))], collapse = "+"))
-)
-data.example <- as.data.frame(X1)
+  # specify the initial formula
+  formula1 <- as.formula(
+    paste(colnames(X1)[ncol(X1)], "~ 1 +", paste0(colnames(X1)[-c(ncol(X1))], collapse = "+"))
+  )
+  data.example <- as.data.frame(X1)
 
-# run the inference with robust g prior
-res1G <- suppressWarnings(
-  suppressMessages(
-    LogicRegr(
-      formula = formula1, data = data.example, family = "Bernoulli", prior = "G",
-      report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.2,
-      p.surv = 0.2, ncores = threads, print.freq = 0L
+  # run the inference with robust g prior
+  res1G <- suppressWarnings(
+    suppressMessages(
+      LogicRegr(
+        formula = formula1, data = data.example, family = "Bernoulli", prior = "G",
+        report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.2,
+        p.surv = 0.2, ncores = threads, print.freq = 0L
+      )
     )
   )
-)
 
-# run the inference with Jeffrey's prior
-res1J <- suppressWarnings(
-  suppressMessages(
-    LogicRegr(
-      formula = formula1, data = data.example, family = "Bernoulli", prior = "J",
-      report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.2,
-      p.surv = 0.2, ncores = threads, print.freq = 0L
+  # run the inference with Jeffrey's prior
+  res1J <- suppressWarnings(
+    suppressMessages(
+      LogicRegr(
+        formula = formula1, data = data.example, family = "Bernoulli", prior = "J",
+        report.level = 0.5, d = 15, cmax = 2, kmax = 15, p.and = 0.9, p.not = 0.2,
+        p.surv = 0.2, ncores = threads, print.freq = 0L
+      )
     )
   )
-)
-test_that("outputs are correct", {
-  expect_equal(ncol(res4G$feat.stat), 2L)
-  expect_equal(ncol(res4J$feat.stat), 2L)
-  expect_equal(ncol(res1G$feat.stat), 2L)
-  expect_equal(ncol(res1J$feat.stat), 2L)
-})
+  test_that("outputs are correct", {
+    expect_equal(ncol(res4G$feat.stat), 2L)
+    expect_equal(ncol(res4J$feat.stat), 2L)
+    expect_equal(ncol(res1G$feat.stat), 2L)
+    expect_equal(ncol(res1J$feat.stat), 2L)
+  })
+}

tests/testthat/test-parall.gmj-example-match-1.4.3.R

@@ -2,7 +2,7 @@ set.seed(80334)
 n_cores <- 1L
 M <- 1L
 n_row <- 100L
-n_col <- 50L
+n_col <- 9L
 n_tot <- n_row * n_col
 X4 <- as.data.frame(
   array(
@@ -13,12 +13,7 @@ X4 <- as.data.frame(
 Y4 <- rnorm(
   n = n_row,
   mean = 1 +
-    7 * (X4$V4 * X4$V17 * X4$V30 * X4$V10) +
-    7 * (X4$V50 * X4$V19 * X4$V13 * X4$V11) +
-    9 * (X4$V37 * X4$V20 * X4$V12) +
-    7 * (X4$V1 * X4$V27 * X4$V3) +
     3.5 * (X4$V9 * X4$V2) +
-    6.6 * (X4$V21 * X4$V18) +
     1.5 * X4$V7 +
     1.5 * X4$V8,
   sd = 1
@@ -46,7 +41,7 @@ vect <- list(
     p.allow.tree = 0.2, p.nor = 0, p.and = 0.9
   ), n.models = 20000, unique = TRUE, max.cpu = n_cores, max.cpu.glob = n_cores,
   create.table = FALSE, create.hash = TRUE, pseudo.paral = TRUE,
-  burn.in = 50, print.freq = 1000,
+  burn.in = 50, print.freq = 0L,
   advanced.param = list(
     max.N.glob = 10L, min.N.glob = 5L, max.N = 3L, min.N = 1L, printable = FALSE
   )
@@ -60,7 +55,7 @@ for (i in seq_len(M)) {
   params[[i]]$simlen <- 21
 }
 
-results <- parall.gmj(X = params, M = n_cores)
+results <- suppressMessages(parall.gmj(X = params, M = n_cores))
 
 test_that("parall.gmj output matches version 1.4.3", {
   expect_length(results, M)