R/model_state.R

In plssem: Complex Partial Least Squares Structural Equation Modeling

initModelStatus <- function(tolerance, max.iter.0_5) {
  list(
    convergence       = FALSE,
    iterations        = 0L,
    iterations.0_5    = 0L,
    tolerance         = tolerance,
    max.iter.0_5      = max.iter.0_5,
    is.admissible     = TRUE,
    mcpls.update.args = NULL,
    quick             = FALSE
  )
}


resetModelStatusLowerOrder <- function(model, hard.reset = FALSE) {
  model@status$convergence <- FALSE
  model@status$iterations.0_5 <- 0L

  if (hard.reset)
    model@status$iterations <- 0L

  model
}


updateModelInfo <- function(model, ...) {
  updates <- list(...)
  if (!length(updates))
    return(model)

  info <- model@info
  for (name in names(updates)) {
    info[[name]] <- updates[[name]]
  }

  info$estimator <- getEstimatorFromInfo(info)
  model@info <- info
  model
}


initModelParams <- function(model) {
  parnames <- getParamVecNames(model)
  labels   <- getParamVecLabels(model)
  k <- length(parnames)

  model@params <- list(
    names          = parnames,
    labels         = labels,
    values         = rep(NA_real_, k),
    se             = rep(NA_real_, k),
    vcov           = NULL,
    Jacobian0      = NULL, # free mc params to free naive params
    Jacobian1      = NULL, # free mc params to all mc params
    JacobianProbs0 = NULL, # empirical probabilities to free MC root equation
    JacobianProbs1 = NULL  # empirical probabilities to all MC params
  )

  model
}


initModelMcArgs <- function(min.iter,
                            max.iter,
                            mc.reps,
                            tol,
                            fixed.seed,
                            polyak.juditsky,
                            pj.extrapolate,
                            delta.se,
                            delta.jacobian.k,
                            fn.args,
                            rescov = "reduced",
                            diag.secant = FALSE,
                            small.sample = FALSE,
                            small.sample.max.k = 50L,
                            small.sample.point.estimate = "median") {
  list(
    min.iter                    = min.iter,
    max.iter                    = max.iter,
    mc.reps                     = mc.reps,
    tol                         = tol,
    fixed.seed                  = fixed.seed,
    polyak.juditsky             = polyak.juditsky,
    pj.extrapolate              = pj.extrapolate,
    delta.se                    = delta.se,
    delta.jacobian.k            = delta.jacobian.k,
    fn.args                     = fn.args,
    rescov                      = rescov,
    diag.secant                 = diag.secant,
    small.sample                = small.sample,
    small.sample.max.k          = small.sample.max.k,
    small.sample.point.estimate = small.sample.point.estimate,
    rng.seed                    = NULL,
    p.start                     = NULL
  )
}


initModelBootInfo <- function(bootstrap,
                              ncores,
                              parallel,
                              R,
                              iseed,
                              optimize,
                              drop.inadmissible,
                              mc.boot.control) {
  list(
    bootstrap         = bootstrap,
    ncores            = ncores,
    parallel          = parallel,
    R                 = R,
    iseed             = iseed,
    optimize          = optimize,
    drop.inadmissible = drop.inadmissible,
    mc.boot.control   = mc.boot.control
  )
}


initModelInfo <- function(baseInfo,
                          parsed,
                          n,
                          ordered,
                          consistent,
                          verbose,
                          standardize,
                          reliabilities,
                          is.lower.order,
                          mc.args,
                          boot,
                          scale) {
  stopifnot(is.list(baseInfo), is.list(parsed))

  info <- baseInfo

  inds.x <- info$inds.x
  inds.y <- info$inds.y

  ordered.x <- intersect(inds.x, ordered)
  ordered.y <- intersect(inds.y, ordered)

  info$lme4.syntax    <- parsed$lme4.syntax
  info$is.mlm         <- parsed$is.mlm
  info$is.mcpls       <- parsed$is.mcpls
  info$mc.fast.lmer   <- parsed$mc.fast.lmer
  info$is.probit      <- parsed$is.probit
  info$cluster        <- parsed$cluster
  info$consistent     <- consistent
  info$ordered        <- ordered
  info$ordered.x      <- ordered.x
  info$ordered.y      <- ordered.y
  info$intTermElems   <- parsed$intTermElems
  info$intTermNames   <- parsed$intTermNames
  info$is.nlin        <- parsed$is.nlin
  info$rng.seed       <- floor(stats::runif(1L, min = 0, max = 9999999))
  info$n              <- n
  info$estimator      <- getEstimatorFromInfo(info)
  info$verbose        <- verbose
  info$standardized   <- standardize
  info$reliabilities  <- reliabilities
  info$is.high.ord    <- FALSE
  info$is.lower.order <- isTRUE(is.lower.order)
  info$mc.args        <- mc.args
  info$boot           <- boot
  info$scale          <- scale

  info
}