R/model_accessors.R

In plssem: Complex Partial Least Squares Structural Equation Modeling

modelData <- function(object) {
  object@data
}


`modelData<-` <- function(object, value) {
  object@data <- value
  object
}


modelMatrices <- function(object) {
  object@matrices
}


`modelMatrices<-` <- function(object, value) {
  object@matrices <- value
  object
}


modelInfo <- function(object) {
  object@info
}


`modelInfo<-` <- function(object, value) {
  object@info <- value
  object
}


modelStatus <- function(object) {
  object@status
}


`modelStatus<-` <- function(object, value) {
  object@status <- value
  object
}


modelParams <- function(object) {
  object@params
}


`modelParams<-` <- function(object, value) {
  object@params <- value
  object
}


modelFit <- function(object) {
  object@fit
}


`modelFit<-` <- function(object, value) {
  object@fit <- value
  object
}


modelFitConsistent <- function(object) {
  object@fitConsistent
}


`modelFitConsistent<-` <- function(object, value) {
  object@fitConsistent <- value
  object
}


modelFitUncorrected <- function(object) {
  object@fitUncorrected
}


`modelFitUncorrected<-` <- function(object, value) {
  object@fitUncorrected <- value
  object
}


modelFitLmer <- function(object) {
  object@fitLmer
}


`modelFitLmer<-` <- function(object, value) {
  object@fitLmer <- value
  object
}


modelFactorScores <- function(object) {
  object@factorScores
}


`modelFactorScores<-` <- function(object, value) {
  object@factorScores <- value
  object
}


parTableInput <- function(object) {
  object@parTableInput
}


`parTableInput<-` <- function(object, value) {
  object@parTableInput <- value
  object
}


higherOrderModel <- function(object) {
  object@higherOrderModel
}


`higherOrderModel<-` <- function(object, value) {
  object@higherOrderModel <- value
  object
}


hasHigherOrderModel <- function(object) {
  !is.null(object@higherOrderModel)
}


hasCombinedModel <- function(object) {
  is(object@combinedModel, "PlsModel")
}


combinedModel <- function(object, refresh = FALSE) {
  if (!refresh && hasCombinedModel(object))
    return(object@combinedModel)

  if (!hasHigherOrderModel(object))
    return(object)

  computeCombinedModel(object)
}


`combinedModel<-` <- function(object, value) {
  object@combinedModel <- value
  object
}


rootModel <- function(object) {
  object@combinedModel <- NULL
  object@higherOrderModel <- NULL
  object
}


# Backwards-compatible accessors (two-level higher-order API).
firstOrder <- function(object) {
  object
}


secondOrder <- function(object) {
  object@higherOrderModel
}


modelParTable <- function(object) {
  object@parTable
}


`modelParTable<-` <- function(object, value) {
  object@parTable <- value
  object
}


modelBoot <- function(object) {
  object@boot
}


`modelBoot<-` <- function(object, value) {
  object@boot <- value

  # Also update se and vcov in model params
  object@params$se   <- value$se
  object@params$vcov <- value$vcov

  if (hasCombinedModel(object)) {
    object@combinedModel@boot <- value
    object@combinedModel@params$se   <- value$se
    object@combinedModel@params$vcov <- value$vcov
  }

  object
}


isAdmissible <- function(object) {
  isTRUE(modelStatus(combinedModel(object))$is.admissible)
}


`isAdmissible<-` <- function(object, recursive = FALSE, value) {
  object@status$is.admissible <- value

  if (recursive) {

    # Higher order
    if (hasHigherOrderModel(object))
      isAdmissible(object@higherOrderModel, recursive = TRUE) <- value

    # Combined model
    if (hasCombinedModel(object))
      isAdmissible(object@combinedModel, recursive = TRUE) <- value

  }

  object
}


`modelStatusIsQuick<-` <- function(object, recursive = TRUE, value) {
  object@status$quick <- value

  if (recursive) {

    # Higher order
    if (hasHigherOrderModel(object))
      modelStatusIsQuick(object@higherOrderModel, recursive = TRUE) <- value

    # Combined model
    if (hasCombinedModel(object))
      modelStatusIsQuick(object@combinedModel, recursive = TRUE) <- value

  }

  object
}


isMLM <- function(object) {
  isTRUE(object@info$is.mlm)
}


isMCPLS <- function(object) {
  isTRUE(object@info$is.mcpls)
}


`isMCPLS<-` <- function(object, recursive = FALSE, value) {
  object@info$is.mcpls <- value

  if (recursive && hasHigherOrderModel(object))
    isMCPLS(higherOrderModel(object)) <- value

  object
}


constructReliabilities <- function(object) {
  modelFit(object)$Q^2
}


inputReliabilities <- function(object) {
  modelInfo(object)$reliabilities
}


`inputReliabilities<-` <- function(object, value) {
  object@info$reliabilities <- value
  object
}


indCorrMatrix <- function(object) {
  object@matrices$S
}


`indCorrMatrix<-` <- function(object, value) {
  object@matrices$S <- value
  object
}