R/run_mlwin.R

In tessaleejohnson/corclus: Simulate Data from the Correlated Cluster Multiple Membership Model

#---------------------------------
# External Dependencies:
# R2MLwiN
# rlang
# progressr
#
# Internal Dependencies:
# build_mm_list
#---------------------------------


#' run_mlwin
#'
#' This function calls \code{\link[R2MLwiN]{runMLwiN}} to estimate the
#' model.
#'
#' @param .dat A dataframe produced by \code{\link{generate_data}}.
#'
#' @param .model_formula A formula object.
#'
#' @param .outcome_dist A string. Defaults to "Normal". See the \code{D}
#' argument in \code{\link[R2MLwiN]{runMLwiN}}.
#'
#' @param .mcmc_burn Numeric. Defaults to 100.
#'
#' @param .mcmc_iter Numeric. Defaults to 1000.
#'
#' @param .mcmc_nchains Numeric. Defaults to 1.
#'
#' @param .mm_list A list. Generated by \code{\link{build_mm_list}}.
#'
#' @param .progress_bar Internal argument passed from \code{\link{run_sim}}.
#' If \code{.progress_bar = TRUE} in the external \code{\link{run_sim}}
#' function, then a progress bar will be displayed while executing this code.
#' The arguments in this internal function defaults to \code{NULL}.
#'
#' @param ... Other parameters passed to the \code{\link[progressr]{progressor}}
#' update.
#'
#' @return Returns a model object produced by \code{\link[R2MLwiN]{runMLwiN}}.
#' @export
#'
#' @examples \dontrun{
#'
#' }
run_mlwin <-
  function(
    .dat,
    .model_formula = as.formula("y ~ 1 + (1 | sch_id_1) + (1 | stu_id)"),
    .outcome_dist = c(
      "Normal",
      "Binomial",
      "Poisson",
      "Negbinom",
      "Unordered Multinomial",
      "Ordered Multinomial",
      "Multivariate Normal",
      "Mixed"
    ),
    .mcmc_burn = 100,
    .mcmc_iter = 1000,
    .mcmc_nchains = 1,
    .mm_list = NULL,
    .progress_bar = NULL,
    ...
  ) {

    ##--setup--##

    # start progress bar

    .dots <- rlang::list2(...)
    if (length(.dots) == 0) {
      .dots <- NA
    }

    if (!is.null(.progress_bar)) {
      .progress_bar(
        message = glue::glue_collapse(.dots, sep = " of "),
        class = "sticky"
      )
    }

    # match .outcome_dist argument
    .outcome_dist <- match.arg(.outcome_dist)

    ##--run model--##

    model_fit <-
      R2MLwiN::runMLwiN(
        .model_formula,
        D = .outcome_dist,
        estoptions = list(
          EstM = 1,
          mcmcMeth = list(
            burnin = .mcmc_burn,
            iterations = .mcmc_iter,
            nchains = .mcmc_nchains
          ),
          mm = .mm_list,
          resi.store = FALSE
        ),
        data = .dat
      )

    ##--output--##
    list(chains = model_fit@chains, BDIC = model_fit@BDIC)


  }