Translated func_MCMC_graph() to C++ (#16)

* Added `src/.gitignore`

* Added placeholder for `func_MCMC_graph_cpp()` (#11)

* Added `cpp` flag (#11)

* Updated docs

* Added test file for `func_MCMC_graph_cpp()` (#11)

* Translated a bit more of #11

* Added FIXME (#11)

* Updated RoxygenNote version

* Properly exporting `func_MCMC_graph_cpp()` (#11)

* Fixed syntax (#11)

* Updated unit test (#11)

* Translated a bit more of #11

* Added commented R code to loop (#11)

* Translated rest of `func_MCMC_graph()' (#11)

* Added unit tests for `func_MCMC_graph()` (#11)

* Put `func_MCMC()` progressbar under `verbose` (#14)

Otherwise, the `pb` would be drawn even if the user sets `verbose = FALSE` on `BayesSurvive()` (which I assume is not the intended behaviour).

* Updated NEWS.md (#11)

DESCRIPTION

@@ -15,7 +15,7 @@ License: GPL-3
 VignetteBuilder: knitr
 Depends: R (>= 4.0)
 Encoding: UTF-8
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 LinkingTo: Rcpp, RcppArmadillo, testthat
 Imports: Rcpp, ggplot2, GGally, mvtnorm, survival, riskRegression,
         utils, stats

NEWS.md

@@ -2,6 +2,7 @@
 
 * Add units tests
 * Rename the output of MPM coefficients in function `coef.BayesSurvive()`
+* Added `cpp` argument to `BayesSurvive()` to allow for faster computation using `Rcpp`
 
 # BayesSurvive 0.0.3
 

R/BayesSurvive.R

@@ -39,6 +39,7 @@
 #' output for parameters 'G', 'V', 'C' and 'Sig' in the graphical model
 #' if \code{MRF.G = FALSE}
 #' @param verbose logical value to display the progess of MCMC
+#' @param cpp logical, whether to use C++ code for faster computation
 #'
 #'
 #' @return An object of class \code{BayesSurvive} is saved as
@@ -108,7 +109,8 @@ BayesSurvive <- function(survObj,
                          burnin = 0,
                          thin = 1,
                          output_graph_para = FALSE,
-                         verbose = TRUE) {
+                         verbose = TRUE,
+                         cpp = FALSE) {
   # same number of covariates p in all subgroups
   p <- ifelse(is.list(survObj[[1]]), NCOL(survObj[[1]]$X), NCOL(survObj$X))
   Beta.ini <- numeric(p)
@@ -306,7 +308,8 @@ BayesSurvive <- function(survObj,
     MRF_2b = MRF2b,
     MRF_G = MRF.G,
     output_graph_para,
-    verbose
+    verbose,
+    cpp
   )
 
   if (S == 1 && MRF.G) {

R/RcppExports.R

@@ -1,6 +1,10 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
+func_MCMC_graph_cpp <- function(sobj, hyperpar, ini, S, method, MRF_2b) {
+    .Call(`_BayesSurvive_func_MCMC_graph_cpp`, sobj, hyperpar, ini, S, method, MRF_2b)
+}
+
 settingInterval_cpp <- function(y, delta_, s_, J_) {
     .Call(`_BayesSurvive_settingInterval_cpp`, y, delta_, s_, J_)
 }

R/func_MCMC.R

@@ -27,6 +27,7 @@
 #' output for parameters 'G', 'V', 'C' and 'Sig' in the graphical model
 #' if \code{MRF_G = FALSE}
 #' @param verbose logical value to display the progess of MCMC
+#' @inheritParams BayesSurvive
 #'
 #' @return A list object saving the MCMC results with components including
 #' 'gamma.p', 'beta.p', 'h.p', 'gamma.margin', 'beta.margin', 's', 'eta0',
@@ -38,7 +39,7 @@
 func_MCMC <- function(survObj, hyperpar, initial,
                       nIter, thin, burnin,
                       S, method, MRF_2b, MRF_G,
-                      output_graph_para, verbose) {
+                      output_graph_para, verbose, cpp = FALSE) {
   # prior parameters for grouped data likelihood of Cox model
   if (method == "Pooled" && MRF_G) { # method = "Pooled"
     hyperpar$s <- sort(survObj$t[survObj$di == 1])
@@ -155,15 +156,17 @@ func_MCMC <- function(survObj, hyperpar, initial,
   # MCMC sampling
 
   # Initializes the progress bar
-  if (verbose) cat("  Running MCMC iterations ...\n")
-  pb <- txtProgressBar(min = 0, max = nIter, style = 3, width = 50, char = "=")
+  if (verbose) {
+    cat("  Running MCMC iterations ...\n")
+    pb <- txtProgressBar(min = 0, max = nIter, style = 3, width = 50, char = "=")
+  }
 
   for (M in 1:nIter) {
     # if (method %in% c("CoxBVSSL", "Sub-struct") ||
     #     (method == "Pooled" && !MRF_G)) {
     if (!MRF_G) {
       # update graph and precision matrix
-      network <- func_MCMC_graph(survObj, hyperpar, ini, S, method, MRF_2b)
+      network <- func_MCMC_graph(survObj, hyperpar, ini, S, method, MRF_2b, cpp)
 
       Sig.ini <- ini$Sig.ini <- network$Sig.ini # precision matrix?
       C.ini <- ini$C.ini <- network$C.ini
@@ -283,9 +286,9 @@ func_MCMC <- function(survObj, hyperpar, initial,
     # }
 
     # Sets the progress bar to the current state
-    setTxtProgressBar(pb, M)
+    if (verbose) setTxtProgressBar(pb, M)
   } # the end of MCMC sampling
-  close(pb) # Close the connection of progress bar
+  if (verbose) close(pb) # Close the connection of progress bar
 
   if (S == 1 && MRF_G) {
     mcmcOutcome$gamma.margin <- mcmcOutcome$gamma.margin / (nIter - burnin)

R/func_MCMC_graph.R

@@ -15,6 +15,7 @@
 #' @param method a method option from
 #' \code{c("Pooled", "CoxBVSSL", "Sub-struct")}
 #' @param MRF_2b two different b in MRF prior for subgraphs G_ss and G_rs
+#' @inheritParams func_MCMC
 #'
 #' @return A list object with components "Sig" the updated covariance matrices,
 #' "G.ini" the updated graph, "V.ini" the updated variances for precision
@@ -23,7 +24,11 @@
 #'
 #'
 #' @export
-func_MCMC_graph <- function(sobj, hyperpar, ini, S, method, MRF_2b) {
+func_MCMC_graph <- function(sobj, hyperpar, ini, S, method, MRF_2b, cpp = FALSE) {
+  if (cpp) {
+    warning("This is not yet fully implemented. Please use cpp = FALSE for production")
+    return(func_MCMC_graph_cpp(sobj, hyperpar, ini, S, method, MRF_2b))
+  }
   n <- sobj$n
   p <- sobj$p
   SSig <- sobj$SSig
@@ -182,6 +187,5 @@ func_MCMC_graph <- function(sobj, hyperpar, ini, S, method, MRF_2b) {
       }
     }
   }
-
   return(list(Sig.ini = Sig, G.ini = G, V.ini = V, C.ini = C))
 }