R/specify_models.R

In seminr: Building and Estimating Structural Equation Models

#' seminr specify_model() function
#'
#' Combines model components together into a single \code{specified_model} object for estimation functions
#'
#' @param measurement_model An optional \code{measurement_model} object representing the outer/measurement model,
#'   as generated by \code{constructs}.
#'
#' @param structural_model An optional \code{smMatrix} object representing the inner/structural model,
#'   as generated by \code{relationships}.
#'
#' @param item_associations An item-to-item matrix representing error
#'   covariances that are freed for estimation.
#'   This matrix is created by \code{associations()}, or defaults to NULL
#'   (no inter-item associations).
#'
#' @return A list containing a SEMinR measurement model, structural model, and item associations.
#'
#' @seealso \code{\link{estimate_pls}} \code{\link{estimate_cbsem}} \code{\link{estimate_cfa}}
#'
#' @export
specify_model <- function(measurement_model, structural_model=NULL, item_associations=NULL) {
  specified_model <- list(
    measurement_model = measurement_model,
    structural_model  = structural_model,
    item_associations = item_associations
  )

  class(specified_model) <- append(class(specified_model), c("specified_model", "seminr_model"))
  specified_model
}

# Internally used logic by seminr api to take apart specified model and override elements as needed
extract_models <- function(model = NULL, measurement_model = NULL, structural_model = NULL, item_associations = NULL) {
  if (inherits(model, "specified_model")) {
    if (is.null(measurement_model)) { measurement_model <- model$measurement_model }
    if (is.null(structural_model)) { structural_model <- model$structural_model }
    if (is.null(item_associations)) { item_associations <- model$item_associations }
  }

  list(measurement_model = measurement_model,
       structural_model = structural_model,
       item_associations = item_associations)
}