Fixed unwrapped examples (#23)

`estimate.bas.glm.cpen()` slightly adapted from <https://github.com/aliaksah/EMJMCMC2016/blob/3954d55fc45296297ee561e0f97f85eb5048c39e/examples/voice%20recognition/voice_bin.R#L45-L69>.

inst/examples/pinferunemjmcmc_example.R

@@ -10,7 +10,7 @@ formula1 <- as.formula(
 )
 
 # define the number or cpus
-M <- 4
+M <- 1L
 # define the size of the simulated samples
 NM <- 1000
 # define \k_{max} + 1 from the paper
@@ -35,7 +35,7 @@ thf <- 0.05
       interact.param = list(allow_offsprings = 3, 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.9, p.and = 0.9),
-      n.models = 10000, unique = TRUE, max.cpu = 4, max.cpu.glob = 4,
+      n.models = 10000, unique = TRUE, max.cpu = M, max.cpu.glob = M,
       create.table = FALSE, create.hash = TRUE, pseudo.paral = TRUE,
       burn.in = 100, print.freq = 1000,
       advanced.param = list(
@@ -81,8 +81,34 @@ formula1 <- as.formula(
 )
 
 \donttest{
+  # Defining a custom estimator function
+  estimate.bas.glm.cpen <- function(
+    formula, data, family, prior, logn, r = 0.1, yid=1,
+    relat =c("cosi","sigmoid","tanh","atan","erf","m(")
+  ) {
+    #only poisson and binomial families are currently adopted
+    X <- model.matrix(object = formula,data = data)
+    capture.output({out <- BAS::bayesglm.fit(x = X, y = data[,yid], family=family,coefprior=prior)})
+    fmla.proc<-as.character(formula)[2:3]
+    fobserved <- fmla.proc[1]
+    fmla.proc[2]<- stringi::stri_replace_all(str = fmla.proc[2],fixed = " ",replacement = "")
+    fmla.proc[2]<- stringi::stri_replace_all(str = fmla.proc[2],fixed = "\n",replacement = "")
+    sj<-2*(stringi::stri_count_fixed(str = fmla.proc[2], pattern = "*"))
+    sj<-sj+1*(stringi::stri_count_fixed(str = fmla.proc[2], pattern = "+"))
+    for(rel in relat) {
+      sj<-sj+2*(stringi::stri_count_fixed(str = fmla.proc[2], pattern = rel))
+    }
+    mlik = ((-out$deviance +2*log(r)*sum(sj)))/2
+    return(
+      list(
+        mlik = mlik, waic = -(out$deviance + 2*out$rank),
+        dic = -(out$deviance + logn*out$rank),
+        summary.fixed = list(mean = coefficients(out))
+      )
+    )
+  }
   res <- pinferunemjmcmc(
-    n.cores = 30, report.level = 0.5, num.mod.best = NM, simplify = TRUE,
+    n.cores = M, report.level = 0.5, num.mod.best = NM, simplify = TRUE,
     predict = TRUE, test.data = as.data.frame(test), link.function = g,
     runemjmcmc.params = list(
       formula = formula1, data = data.example, gen.prob = c(1, 1, 1, 1, 0),
@@ -97,7 +123,7 @@ formula1 <- as.formula(
         allow_offsprings = 4, mutation_rate = 100, last.mutation = 1000,
         max.tree.size = 6, Nvars.max = 20, p.allow.replace = 0.5,
         p.allow.tree = 0.4, p.nor = 0.3, p.and = 0.9
-      ), n.models = 7000, unique = TRUE, max.cpu = 4, max.cpu.glob = 4,
+      ), n.models = 7000, unique = TRUE, max.cpu = M, max.cpu.glob = M,
       create.table = FALSE, create.hash = TRUE, pseudo.paral = TRUE,
       burn.in = 100, print.freq = 1000,
       advanced.param = list(
@@ -107,12 +133,6 @@ formula1 <- as.formula(
     )
   )
 
-  print(auc(prob = res$predictions, y = test$X))
-  for (i in 1:M) {
-    print(auc(prob = res$threads.stats[[i]]$preds, y = test$X))
-    print(res$threads.stats[[i]]$post.populi)
-  }
-
   for (jjjj in 1:10)
   {
     resw <- as.integer(res$predictions >= 0.1 * jjjj)