R/set_control.R

In brokenstick: Broken Stick Model for Irregular Longitudinal Data

#' Set controls to steer calculations
#'
#' @param method String indicating estimation method: `"kr"` or `"lmer"`
#' @param kr A list generated by [control_kr].
#' @param lmer A list generated by [lme4::lmerControl]. The default
#' is set to `lmerControl(check.nobs.vs.nRE = "warning")`, which turns
#' fatal errors with respect the number of parameters into warnings. Use
#' `lmerControl(check.nobs.vs.nRE = "ignore")` to silence `lmer()`.
#' @param \dots Forwards arguments to [control_kr()]
#' @return For method `"kr"`, a list returned by [control_kr()].
#'         For method `"lmer"`, an object of class `lmerControl`.
#'         For other methods, `set_control()` returns `NULL`.
#' @examples
#' # defaults
#' control <- set_control()
#' control
#' @export
set_control <- function(method = c("kr", "lmer"),
                        kr = control_kr(...),
                        lmer = lmerControl(check.nobs.vs.nRE = "warning"),
                        ...) {
  method <- match.arg(method)
  if (method == "kr") {
    return(kr)
  }
  if (method == "lmer") {
    return(lmer)
  }
  return(NULL)
}

#' Set controls for Kasim-Raudenbush sampler
#' @param niter      Integer. Number of samples from posterior. Default:  `200`.
#' @param nimp      Integer. Number of multiple imputations. Default: `0`.
#' @param start    Integer. The iteration number of the first observation
#' @param thin     Integer. The thinning interval between consecutive observations
#' @param seed     Integer. Seed number for [base::set.seed()]. Use `NA` to
#' bypass seed setting.
#' @param cormodel String indicating the correlation model:
#'                 `"none"` (default), `"argyle"` or `"cole"`
#' @param \dots    Allow for dot parameters
#' @return A list with eight components. The function calculates parameters
#' `end` (the iteration number of the last iteration) and `thin_imp`
#' (thinning factor for multiple imputations) from the other inputs.
#' @export
control_kr <- function(niter = 200L,
                       nimp = 0L,
                       start = 101L,
                       thin = 1L,
                       seed = NA_integer_,
                       cormodel = c("none", "argyle", "cole"),
                       ...) {
  cormodel <- match.arg(cormodel)

  end <- start + niter * thin
  if (nimp > niter) {
    stop("Number of imputations (nimp = ", nimp, ") exceeds number of parameter draws (niter = ", niter, ").")
  }
  thin_imp <- ifelse(nimp, as.integer((end - start) / nimp), Inf)

  obj <- list(
    niter = niter,
    nimp = nimp,
    start = start,
    end = end,
    thin = thin,
    thin_imp = thin_imp,
    seed = seed,
    cormodel = cormodel
  )

  return(obj)
}