pbugs: Run 'WinBUGS' or 'OpenBUGS' Models in Parallel

Documented in pbugs

#' @title Run \code{WinBUGS} or \code{OpenBUGS} Models in Parallel
#'
#' @description Run \code{WinBUGS} or \code{OpenBUGS} models from your \code{R}
#'   session running parallel instances of these programs, one per chain. In
#'   this manner several cores (one per chain) are used to run the MCMC
#'   simulation of the corresponding model. Results are returned in an object of
#'   \code{bugs} and \code{pbugs} classes.
#'
#' @details This function basically executes parallel calls (one per chain) to
#'   \code{R2WinBUGS::bugs}, so it is possible to use almost all the
#'   arguments associated to that function. The \code{summary.only} argument of
#'   \code{bugs} can be only set equal to \code{FALSE} in \code{pbugs}.
#'
#'   The idea of the \code{pbugs} implementation is to minimize code adaptation
#'   from regular \code{bugs} instances. Suitable code for the \code{bugs}
#'   function should run in principle in parallel by simply calling to the
#'   \code{pbugs} function with the same arguments as the original \code{bugs}
#'   call.
#'
#'   Aditionally, this function has some enhanced functionality as compared to
#'   \code{bugs} such as replacing \code{WinBUGS}' adaptive rejection sampler
#'   (\code{DFreeARS}) by a \code{Slice} sampler, to sort out some classical
#'   'Traps', from \code{R}. This option does not work with \code{OpenBUGS}.
#'
#'   Note that when \code{DIC == TRUE} in \code{pbugs}, DICs and their
#'   components are calculated as the mean of the different DICs returned per
#'   each of the chains run. If convergence is appropriately achieved this
#'   should not be hardly different to the DIC calcuted for all the chains
#'   simulated.
#'
#' @usage pbugs(data, inits, parameters.to.save, model.file,debug = FALSE, program =
#'   c("winbugs", "openbugs"),bugs.directory = "default", cluster = NULL, pbugs.directory
#'   = "default",slice = FALSE, OpenBUGS.pgm = "default", cluster_export = NULL, ...)
#'
#' @param data List or character. Either a named list (names corresponding to
#'   variable names in the \code{model.file}) of the data for the \code{WinBUGS}
#'   model, or (which is not recommended and unsafe) a vector or list of the
#'   names of the data objects used by the model. If \code{data} is a one
#'   element character vector (such as \code{"data.txt"}), it is assumed that
#'   data have already been written to the working directory into that file,
#'   e.g. by the function \code{bugs.data}. This argument is
#'   also required, with the same format, by the \code{R2WinBUGS::bugs}
#'   function.
#' @param inits Function or list (length == n.chains). List with \code{n.chains}
#'   elements; each element of the list is itself a list of starting values for
#'   the \code{WinBUGS} model, or a function creating (possibly random) initial
#'   values. Alternatively, if \code{inits = NULL}, initial values are generated
#'   by \code{WinBUGS} (if possible). If \code{inits} is a character vector with
#'   \code{n.chains} elements, it is assumed that inits have already been
#'   written to the working directory into those files, e.g. by the function
#'   \code{bugs.inits}. This argument is also required, with
#'   the same format, by the \code{R2WinBUGS::bugs} function.
#' @param parameters.to.save Character vector of the names of the parameters to
#'   save which should be monitored. This argument is also required, with the
#'   same format, by the \code{R2WinBUGS::bugs} function.
#' @param model.file Function or character (length 1). File containing the model
#'   written in \code{WinBUGS} code. The extension can be either '\code{.bug}'
#'   or '\code{.txt}'. If the extension is '\code{.bug}' and \code{program ==
#'   "WinBUGS"}, a copy of the file with extension \code{'.txt'} will be created
#'   in the \code{pbugs()} call and removed afterwards. Note that similarly
#'   named \code{'.txt'} files will be overwritten. Alternatively,
#'   \code{model.file} can be an R function that contains a BUGS model that is
#'   written to a temporary model file (see \code{\link[base]{tempfile}}) using
#'   \code{write.model}. This argument is also required, with
#'   the same format, by the \code{R2WinBUGS::bugs} function.
#' @param debug Logical, default: FALSE. Open \code{WinBUGS} in debug mode. It
#'   does not work for \code{OpenBUGS} in Unix OS's (only through Wine:
#'   \code{useWINE == TRUE}).
#' @param program Character (length 1), default argument: \code{"winbugs"}. The
#'   program to use for the MCMC inference, either \code{WinBUGS} or
#'   \code{OpenBUGS}.
#' @param bugs.directory Character (length 1), default: system dependent
#'   (Unix-Windows). The default argument calls to the corresponding default
#'   argument of the \code{R2WinBUGS::bugs} function. Directory where
#'   \code{WinBUGS} is installed. Several copies (as many as chains to be run)
#'   of this directory are created at the \code{pbugs.directory} folder, if they
#'   are not still created.
#' @param cluster Integer (length 1), default: NULL. Number of computer cores to
#'   use for running the model. If not provided, the function sets it to the
#'   minimum of the number of available cores minus one the number of chains
#'   run.
#' @param pbugs.directory Character (length 1). Path to the pbugs directory were
#'   different copies (one per chain) of either \code{WinBUGS} or
#'   \code{OpenBUGS} are stored. Default value is
#'   "/home/user/.wine/drive_c/pbugs/winbugs" for \code{WinBUGS} and
#'   "/home/user/.wine/drive_c/pbugs/openbugs" for \code{OpenBUGS} on UNIX OS's
#'   and "c:/pbugs/winbugs" and "c:/pbugs/openbugs" on Windows OS.
#' @param slice Logical, default: FALSE. Should \code{WinBUGS}' adaptive
#'   rejection sampler (\code{DFreeARS}) for log-concave distributions be
#'   replaced by a \code{Slice} sampler? This is useful to sort out some
#'   \code{Traps} as described in the "Changing MCMC defaults" section of the
#'   \code{WinBUGS} help. This argument does not work with \code{OpenBUGS}.
#' @param OpenBUGS.pgm Character (length 1), default: system dependent
#'   (Unix-Windows).  The default argument calls to the corresponding default
#'   argument of the \code{R2WinBUGS::bugs} function. Directory where
#'   \code{OpenBUGS} is installed. Several copies (as many as chains to be run)
#'   of this directory are created at the \code{pbugs.directory} folder, if they
#'   are not still created.
#' @param cluster_export Character, default: NULL. Additional objects to export to
#'   computer cores.
#' @param ... Additional arguments to be passed to \code{R2WinBUGS::bugs}
#'   function.
#'
#' @return The arguments in the returned \code{pbugs} object are the same than
#'   for any \code{R2WinBUGS::bugs} object, plus the following:
#'   \item{exec_time}{Execution time taken by the function} \item{seed}{Seed
#'   used, for reproducible simulations} \item{n_cores}{Number of computer cores
#'   used}
#'
#' @examples
#'
#' \dontrun{
#'   library(pbugs)
#'   data(sample_df)
#'   bugs_model <- function() {
#'     for (i in 1:N) {
#'       y[i] ~ dbern(pi[i])
#'       logit(pi[i]) <- beta[1] + beta[2] * x1[i] + beta[3] * x2[i] + beta[4] * x3[i]
#'     }
#'     for (j in 1:4) {
#'       beta[j] ~ dflat()
#'     }
#'   }
#'   bugs_data <- with(sample_df, list(y = y, x1 = x1, x2 = x2, x3 = x3, N = length(y)))
#'   bugs_init <- function() list(beta = rnorm(4, sd = .5))
#'   bugs_pars <- c("beta", "pi")
#'   result    <- pbugs(data = bugs_data, inits = bugs_init, parameters.to.save = bugs_pars,
#'                      model.file = bugs_model, n.thin = 1, n.chains = 4)
#' }
#'
#' @seealso \code{R2WinBUGS::bugs}
#'
#' @export
pbugs <- function(data, inits, parameters.to.save, model.file,
                  debug = FALSE, program = c("winbugs", "openbugs"),
                  bugs.directory = "default", cluster = NULL, pbugs.directory = "default",
                  slice = FALSE, OpenBUGS.pgm = "default", cluster_export = NULL, ...) {

  stopifnot(is.character(pbugs.directory))
  if (!is.null(cluster)) {
    stopifnot(is.numeric(cluster) && length(cluster) == 1)
  }
  program <- tolower(program)
  program <- match.arg(program)
  if (pbugs.directory == "default") {
    pbugs.directory <- ifelse(
      .Platform$OS.type == "unix",
      path.expand(paste0("~/.wine/drive_c/pbugs/", program)),
      paste0("c:/pbugs/", program)
    )
  }

  i.time <- Sys.time()
  if (program == "winbugs") {
    if (bugs.directory == "default") {
      bugs.directory <- ifelse(
        .Platform$OS.type == "unix",
        path.expand("~/.wine/drive_c/Program Files/WinBUGS14"),
        "C:/Program Files/WinBUGS14"
      )
    }
    bugs.obj <- pwinbugs(
      data               = data,
      inits              = inits,
      parameters.to.save = parameters.to.save,
      model.file         = model.file,
      debug              = debug,
      bugs.directory     = bugs.directory,
      cluster            = cluster,
      pbugs.directory    = pbugs.directory,
      slice              = slice,
      cluster_export     = cluster_export,
      ...
    )
  } else {
    bugs.obj <- popenbugs(
      data               = data,
      inits              = inits,
      parameters.to.save = parameters.to.save,
      model.file         = model.file,
      OpenBUGS.pgm       = OpenBUGS.pgm,
      debug              = debug,
      pbugs.directory    = pbugs.directory,
      cluster            = cluster,
      cluster_export     = cluster_export,
      ...
    )
  }
  f.time             <- Sys.time()
  exec.time          <- f.time - i.time
  bugs.obj$exec.time <- exec.time

  return(bugs.obj)
}