#
# Copyright 2007-2020 by the individuals mentioned in the source code history
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
##' MxLISRELModel
##'
##' This is an internal class and should not be used directly.
##'
##' @aliases
##' $<-,MxLISRELModel-method
##' [[<-,MxLISRELModel-method
setClass(Class = "MxLISRELModel",
representation = representation(),
contains = "MxModel")
imxModelTypes[['LISREL']] <- "MxLISRELModel"
#--------------------------------------------------------------------
# Define generic functions
setMethod("imxTypeName", "MxLISRELModel",
function(model) { "LISREL" }
)
setMethod("imxInitModel", "MxLISRELModel",
function(model) {
# Returns an ML fitfunction and an expectation with al NA matrices
# add needed matrices later
if (is.null(model[['expectation']])) {
model[['expectation']] <- mxExpectationLISREL()
}
if (is.null(model[['fitfunction']])) {
model[['fitfunction']] <- mxFitFunctionML()
}
return(model)
}
)
addExogenousMatrices <- function(model, manifest, latent){
if (is.null(model[['LX']])) {
model[['LX']] <- createMatrixLISREL(model, manifest, latent, 'LX')
}
if (is.null(model[['PH']])) {
model[['PH']] <- createMatrixLISREL(model, latent, latent, 'PH')
}
if (is.null(model[['TD']])) {
model[['TD']] <- createMatrixLISREL(model, manifest, manifest, 'TD')
}
return(model)
}
addEndogenousMatrices <- function(model, manifest, latent){
if (is.null(model[['LY']])) {
model[['LY']] <- createMatrixLISREL(model, manifest, latent, 'LY')
}
if (is.null(model[['BE']])) {
model[['BE']] <- createMatrixLISREL(model, latent, latent, 'BE')
}
if (is.null(model[['PS']])) {
model[['PS']] <- createMatrixLISREL(model, latent, latent, 'PS')
}
if (is.null(model[['TE']])) {
model[['TE']] <- createMatrixLISREL(model, manifest, manifest, 'TE')
}
return(model)
}
addExoEndoMatrices <- function(model, manifestExo, manifestEndo, latentExo, latentEndo){
model <- addExogenousMatrices(model, manifestExo, latentExo)
model <- addEndogenousMatrices(model, manifestEndo, latentEndo)
if (is.null(model[['GA']])) {
model[['GA']] <- createMatrixLISREL(model, latentEndo, latentExo, 'GA')
}
if (is.null(model[['TH']])) {
model[['TH']] <- createMatrixLISREL(model, manifestEndo, manifestExo, 'TH')
}
return(model)
}
createMatrixLISREL <- function(model, rowvariables, colvariables, matrixname){
clen <- length(colvariables)
rlen <- length(rowvariables)
names <- list(rowvariables, colvariables)
values <- matrix(0, rlen, clen)
free <- matrix(FALSE, rlen, clen)
labels <- matrix(as.character(NA), rlen, clen)
if(matrixname %in% c('LX', 'LY', 'BE', 'GA', 'TX', 'TY', 'KA', 'AL', 'TH')){
matrixtype <- 'Full'
} else if(matrixname %in% c('PH', 'PS', 'TD', 'TE')){
matrixtype <- 'Symm'
}
retval <- mxMatrix(matrixtype, values = values, free = free, labels = labels, name = matrixname)
dimnames(retval) <- names
return(retval)
}
setMethod("imxModelBuilder", "MxLISRELModel",
function(model, lst, name, manifestVars, latentVars, productVars, submodels, remove, independent) {
model <- nameArgument(model, name)
model <- variablesArgumentLISREL(model, manifestVars, latentVars, productVars, submodels, remove)
model <- listArgumentLISREL(model, lst, remove)
notPathOrData <- getNotPathsOrData(lst)
callNextMethod(model, notPathOrData, NA, character(), character(), character(), list(), remove, independent)
#stop("Not implemented")
}
)
setMethod("imxVerifyModel", "MxLISRELModel",
function(model) {
# TODO somewhere in here add check that at least one of LX or LY exist
return(TRUE)
}
)
setReplaceMethod("[[", "MxLISRELModel",
function(x, i, j, value) {
return(replaceMethodLISREL(x, i, value))
}
)
setReplaceMethod("$", "MxLISRELModel",
function(x, name, value) {
replaceMethodLISREL(model=x, index=name, value=value)
}
)
# Helpers for LISREL models
variablesArgumentLISREL <- function(model, manifestVars, latentVars, productVars, submodels, remove){
if (single.na(manifestVars)) {
manifestVars <- character()
}
if (single.na(latentVars)) {
latentVars <- character()
}
if(length(productVars) > 0 && !single.na(productVars)) {
stop("Whoopsie! Product nodes/variables are not currently supported for LISREL MxModel objects.")
}
if (remove == TRUE) {
if (length(latentVars) + length(manifestVars) > 0) {
model <- removeVariablesLISREL(model, latentVars, manifestVars)
}
if (length(submodels)) for(i in 1:length(submodels)) {
model <- removeSingleNamedEntity(model, submodels[[i]])
}
} else {
if (length(manifestVars) + length(latentVars) > 0) {
if(length(latentVars) == 0) {
stop("Unlike RAM, LISREL models must have latent variables.")
}
if (!is.list(latentVars)) latentVars <- list(endo=latentVars)
if (length(manifestVars) && !is.list(manifestVars)) manifestVars <- list(endo=manifestVars)
latentVars <- varsToCharacter(latentVars, "latent")
manifestVars <- varsToCharacter(manifestVars, "manifest")
checkVariables(model, latentVars, manifestVars)
model <- addVariablesLISREL(model, latentVars, manifestVars)
}
if (length(submodels)) for(i in 1:length(submodels)) {
model <- addSingleNamedEntity(model, submodels[[i]])
}
}
return(model)
}
removeVariablesLISREL <- function(model, latent, manifest){
return(model)
}
addVariablesLISREL <- function(model, latent, manifest){
# works for initialization
# TODO add processing for adding/removing variables and variables switching from exo to endo.
model <- addVariablesHelper(model, "latentVars", latent)
model <- addVariablesHelper(model, "manifestVars", manifest)
mexog <- model@manifestVars$exogenous
mendo <- model@manifestVars$endogenous
lexog <- model@latentVars$exogenous
lendo <- model@latentVars$endogenous
# if has only exogenous variables
if(length(mexog) > 0 & length(mendo) == 0){
model <- addExogenousMatrices(model, mexog, lexog)
theExpectation <- mxExpectationLISREL(LX='LX', PH='PH', TD='TD', TX=NA, KA=NA)
# if has only endogenous variables
} else if(length(mexog) == 0 & length(mendo) > 0){
model <- addEndogenousMatrices(model, mendo, lendo)
theExpectation <- mxExpectationLISREL(LY='LY', BE='BE', PS='PS', TE='TE', TY=NA, AL=NA)
# if has both exogenous and endogenous variables
} else {
model <- addExoEndoMatrices(model, mexog, mendo, lexog, lendo)
theExpectation <- mxExpectationLISREL(LX='LX', PH='PH', TD='TD', TX=NA, KA=NA, LY='LY', BE='BE', PS='PS', TE='TE', TY=NA, AL=NA, GA='GA', TH='TH')
}
model[['expectation']] <- theExpectation
return(model)
}
addVariablesMatrixLISREL <- function(oldMatrix, value, model, numNewRows, numNewCols, varType, varSubtype){
slot(model, varType)[[varSubtype]] #e.g. get the manifestVars$exogenous with varType="manifestVars" and varSubtype="exogenous"
}
replaceMethodLISREL <- function(model, index, value){
pair <- imxReverseIdentifier(model, index)
namespace <- pair[[1]]
name <- pair[[2]]
if (namespace == model@name && name == "data") {
hasExogenousVars <- length(c(model@manifestVars$exogenous, model@latentVars$exogenous)) > 0
hasEndogenousVars <- length(c(model@manifestVars$endogenous, model@latentVars$endogenous)) > 0
model@data <- value
if (requireMeansVector(value)) {
if(hasExogenousVars){
model <- addExogenousMeansLISREL(model)
}
if(hasEndogenousVars){
model <- addEndogenousMeansLISREL(model)
}
}
} else {
model <- imxReplaceMethod(model, index, value)
}
return(model)
}
addExogenousMeansLISREL <- function(model){
if (is.null(model[['TX']])) {
model[['TX']] <- createMatrixLISREL(model, model@manifestVars$exogenous, "one", 'TX')
}
if (is.null(model[['KA']])) {
model[['KA']] <- createMatrixLISREL(model, model@latentVars$exogenous, "one", 'KA')
}
model@expectation@TX <- "TX"
model@expectation@KA <- "KA"
return(model)
}
addEndogenousMeansLISREL <- function(model){
if (is.null(model[['TY']])) {
model[['TY']] <- createMatrixLISREL(model, model@manifestVars$endogenous, "one", 'TY')
}
if (is.null(model[['AL']])) {
model[['AL']] <- createMatrixLISREL(model, model@latentVars$endogenous, "one", 'AL')
}
model@expectation@TY <- "TY"
model@expectation@AL <- "AL"
return(model)
}
listArgumentLISREL <- function(model, lst, remove){
if(remove == TRUE) {
model <- removeEntriesLISREL(model, lst)
} else {
model <- addEntriesLISREL(model, lst)
}
return(model)
}
removeEntriesLISREL <- function(model, entries){
stop("Removing paths not yet implemented for LISREL")
}
addEntriesLISREL <- function(model, entries){
if (length(entries) == 0) {
return(model)
}
filter <- sapply(entries, is, "MxPath")
paths <- entries[filter]
if (length(paths) > 0) {
model <- insertAllPathsLISREL(model, paths)
}
filter <- sapply(entries, is, "MxThreshold")
thresholds <- entries[filter]
if(length(thresholds) > 0) {
model <- insertAllThresholdsRAM(model, thresholds) # sic. Re-use RAM threholds
}
filter <- sapply(entries, is, "DiscreteBase")
discrete <- entries[filter]
if(length(discrete)) {
model <- insertDiscreteRAM(model, discrete)
}
filter <- sapply(entries, is, "MxData")
data <- entries[filter]
if (length(data) > 0) {
if (length(data) > 1) {
warning("Multiple data sources specified. Only one will be chosen.")
}
data <- data[[1]]
model@data <- data
# If the data are WLS, then change the fit function to WLS away from the default ML.
if(is(model@data,"MxDataLegacyWLS") && class(model@fitfunction) %in% "MxFitFunctionML"){
model[['fitfunction']] <- mxFitFunctionWLS()
}
#model[['F']] <- createMatrixF(model) #TODO something here about re-structuring LX and LY if needed
}
return(model)
}
insertAllPathsLISREL <- function(model, paths){
manivars <- model@manifestVars
latevars <- model@latentVars
exvars <- c(manivars$exogenous, latevars$exogenous)
envars <- c(manivars$endogenous, latevars$endogenous)
theVariables <- list(lex=latevars$exogenous, len=latevars$endogenous, mex=manivars$exogenous, men=manivars$endogenous)
theMatrices <- list(LX=model[['LX']], LY=model[['LY']], BE=model[['BE']], GA=model[['GA']], PH=model[['PH']],
PS=model[['PS']], TD=model[['TD']], TE=model[['TE']], TH=model[['TH']])
TX <- model[['TX']]
TY <- model[['TY']]
KA <- model[['KA']]
AL <- model[['AL']]
legalVars <- c(exvars, envars, "one")
for(i in 1:length(paths)) {
path <- paths[[i]]
missingvalues <- is.na(path@values)
path@values[missingvalues] <- 0
if (single.na(path@to)) {
path@to <- path@from
paths[[i]] <- path
}
allFromTo <- unique(c(path@from, path@to))
varExist <- allFromTo %in% legalVars
if(!all(varExist)) {
missingVars <- allFromTo[!varExist]
stop(paste("You need to add",
omxQuotes(missingVars),
"to either manifestVars or latentVars before you",
"can use them in a path."), call. = FALSE)
}
if (length(path@from) == 1 && (path@from == "one")) {
if ( (is.null(TX) || is.null(KA)) && any(path@to %in% exvars) ) {
model <- addExogenousMeansLISREL(model)
TX <- model[['TX']]
KA <- model[['KA']]
}
if ( (is.null(TY) || is.null(AL)) && any(path@to %in% envars) ) {
model <- addEndogenousMeansLISREL(model)
TY <- model[['TY']]
AL <- model[['AL']]
}
LISRELMeans <- insertMeansPathLISREL(path, TX, TY, KA, AL, manifest=manivars, latent=latevars)
TX <- LISRELMeans[[1]]; TY <- LISRELMeans[[2]]; KA <- LISRELMeans[[3]]; AL <- LISRELMeans[[4]]
model <- updateLISRELMeans(model, LISRELMeans)
} else {
expanded <- expandPathConnect(path@from, path@to, path@connect)
path@from <- expanded$from
path@to <- expanded$to
theMatrices <- insertPathLISREL(path, theMatrices, theVariables)
LISRELMeans <- NULL
}
}
model <- updateLISRELMatrices(model, theMatrices)
return(model)
}
insertPathLISREL <- function(path, matrices, variables){
allfrom <- path@from
allto <- path@to
allarrows <- path@arrows
allfree <- path@free
allvalues <- path@values
alllabels <- path@labels
alllbound <- path@lbound
allubound <- path@ubound
maxlength <- max(length(allfrom), length(allto))
for(i in 0:(maxlength - 1)) {
from <- allfrom[[i %% length(allfrom) + 1]]
to <- allto[[i %% length(allto) + 1]]
arrows <- allarrows[[i %% length(allarrows) + 1]]
if (arrows == 0) stop("MxPath with arrows==0 is not supported by LISREL") # maybe possible TODO
new <- list()
new$value <- allvalues[[i %% length(allvalues) + 1]]
new$free <- allfree[[i %% length(allfree) + 1]]
new$label <- alllabels[[i %% length(alllabels) + 1]]
new$ubound <- allubound[[i %% length(allubound) + 1]]
new$lbound <- alllbound[[i %% length(alllbound) + 1]]
#N.B. assuming that length(from) and length(to) are both 1
if(from %in% variables$lex){
matrices <- insertLatentExoPathsLISREL(from, to, arrows, old=matrices, new, variables)
} else if(from %in% variables$len){
matrices <- insertLatentEndoPathsLISREL(from, to, arrows, old=matrices, new, variables)
} else if(from %in% variables$mex){
matrices <- insertManifestExoPathsLISREL(from, to, arrows, old=matrices, new, variables)
} else if(from %in% variables$men){
matrices <- insertManifestEndoPathsLISREL(from, to, arrows, old=matrices, new, variables)
}
}
return(matrices)
}
# Schematic of where each entry goes depending on its 'from' and 'to' and 'arrows' arguments
#from -> to
# We could first try to assign the path to one of the 13 valid combinations
# and then throw an error with the particulars of the invalid combination.
# stop(paste('Tried to add a', oneOrtwo, '-headed path from an', exoORendoFrom, latentORmanifestFrom, 'variable to an',
# exoORendoTo, latentORmanifestTo, 'variable, but that is not possible in LISREL.'))
#latentExo -> latentExo
# if arrows==1
# stop('nonsense')
# if arrows==2
# add to PH
#latentExo -> latentEndo
# if arrows==1
# add to GA
# if arrows=2
# stop('nonsense')
#latentExo -> manifestExo
# if arrows=1
# add to LX
# if arrows=2
# stop('nonsense')
#latentExo -> manifestEndo
# stop('nonsense')
#latentExo -> 'one'
# stop('nonsense')
assignNewMatrixStuff <- function(from, to, oldMat, newStuff, remove=FALSE){
if(remove==FALSE){
oldMat$values[to, from] <- newStuff$value
oldMat$free[to, from] <- newStuff$free
oldMat$labels[to, from] <- newStuff$label
oldMat$lbound[to, from] <- newStuff$lbound
oldMat$ubound[to, from] <- newStuff$ubound
} else {
oldMat$values[to, from] <- 0
oldMat$labels[to, from] <- as.character(NA)
oldMat$free[to, from] <- FALSE
}
return(oldMat)
}
insertLatentExoPathsLISREL <- function(from, to, arrows, old, new, variables){
if(to %in% variables$lex){
if(arrows==1){
stop('In LISREL, one-headed arrows do not exist between latent exogenous variables. They are allowed when the destination is endogenous, and two-headed arrows are okay.')
} else if(arrows==2){
#add to PH
old$PH <- assignNewMatrixStuff(from, to, old$PH, new)
old$PH <- assignNewMatrixStuff(to, from, old$PH, new)
}
} else if(to %in% variables$len){
if(arrows==1){
#add to GA
old$GA <- assignNewMatrixStuff(from, to, old$GA, new)
} else if(arrows==2){
stop('In LISREL, two-headed arrows do not exist between latent exogenous and latent endogenous variables. One-headed arrows are okay.')
}
} else if(to %in% variables$mex){
if(arrows==1){
#add to LX
old$LX <- assignNewMatrixStuff(from, to, old$LX, new)
} else if(arrows==2){
stop('In LISREL, two-headed arrows do not exist between latent and manifest exogenous variables.')
}
} else if(to %in% variables$men){
stop('In LISREL, one-headed arrows cannot go from latent exogenous variables to manifest endogenous variables.')
}
return(old)
}
#latentEndo -> latentExo
# stop('nonsense')
#latentEndo -> latentEndo
# if arrows==1
# add to BE
# if arrows==2
# add to PS
#latentEndo -> manifestExo
# stop('nonsense')
#latentEndo -> manifestEndo
# if arrows==1
# add to LY
# if arrows==2
# stop('nonsense')
#latentEndo -> 'one'
# stop('nonsense')
insertLatentEndoPathsLISREL <- function(from, to, arrows, old, new, variables){
if(to %in% variables$lex){
stop('In LISREL, no paths can go from latent endogenous variables to latent exogenous variables.')
} else if(to %in% variables$len){
if(arrows==1){
#add to BE
old$BE <- assignNewMatrixStuff(from, to, old$BE, new)
old$PS <- assignNewMatrixStuff(from, to, old$PS, new, remove=TRUE)
} else if(arrows==2){
#add to PS
old$PS <- assignNewMatrixStuff(from, to, old$PS, new)
old$PS <- assignNewMatrixStuff(to, from, old$PS, new)
old$BE <- assignNewMatrixStuff(from, to, old$BE, new, remove=TRUE)
}
} else if(to %in% variables$mex){
stop('In LISREL, no paths can go from latent endogenous variables to manifest exogenous variables.')
} else if(to %in% variables$men){
if(arrows==1){
#add to LY
old$LY <- assignNewMatrixStuff(from, to, old$LY, new)
} else if(arrows==2){
stop('In LISREL, two-headed arrows do not exist between latent and manifest endogenous variables.')
}
}
return(old)
}
#manifestExo -> latentExo
# stop('nonsense')
#manifestExo -> latentEndo
# stop('nonsense')
#manifestExo -> manifestExo
# if arrows==1
# stop('nonsense')
# if arrows==2
# add to TD
#manifestExo -> manifestEndo
# if arrows==1
# stop('nonsense')
# if arrows==2
# add to TH
#manifestExo -> 'one'
# stop('nonsense')
manifestToLatentError <- function(from, to) {
stop(paste('In LISREL, paths are not allowed from manifest variables to latent variables;',
'from=',omxQuotes(from), 'to=', omxQuotes(to)))
}
insertManifestExoPathsLISREL <- function(from, to, arrows, old, new, variables){
if(to %in% variables$lex || to %in% variables$len){
manifestToLatentError(from, to)
} else if(to %in% variables$mex){
if(arrows==1){
stop('In LISREL, one-headed arrows are not allowed between manifest exogenous variables.')
} else if(arrows==2){
#add to TD
old$TD <- assignNewMatrixStuff(from, to, old$TD, new)
old$TD <- assignNewMatrixStuff(to, from, old$TD, new)
}
} else if(to %in% variables$men){
if(arrows==1){
stop('In LISREL, one-headed arrows are not allowed between manifest exogenous and manifest endogenous variables.')
} else if(arrows==2){
#add to TH
old$TH <- assignNewMatrixStuff(from, to, old$TH, new)
# N.B. TH is asymmetric so do NOT at the to->from path
}
}
return(old)
}
#manifestEndo -> latentExo
# stop('nonsense')
#manifestEndo -> latentEndo
# stop('nonsense')
#manifestEndo -> manifestExo
# if arrows==1
# stop('nonsense')
# if arrows==2
# add to TH
#manifestEndo -> manifestEndo
# if arrows==1
# stop('nonsense')
# if arrows==2
# add to TE
#manifestEndo -> 'one'
# stop('nonsense')
insertManifestEndoPathsLISREL <- function(from, to, arrows, old, new, variables){
if(to %in% variables$lex || to %in% variables$len){
manifestToLatentError(from, to)
} else if(to %in% variables$mex){
if(arrows==1){
stop('In LISREL, one-headed arrows are not allowed between manifest exogenous variables.')
} else if(arrows==2){
#add to TH
old$TH <- assignNewMatrixStuff(to, from, old$TH, new) #Note the switch of the from/to
# N.B. TH is asymmetric so do NOT at the to->from path
}
} else if(to %in% variables$men){
if(arrows==1){
stop('In LISREL, one-headed arrows are not allowed between manifest variables.')
} else if(arrows==2){
#add to TE
old$TE <- assignNewMatrixStuff(from, to, old$TE, new)
old$TE <- assignNewMatrixStuff(to, from, old$TE, new)
}
}
return(old)
}
# 'one' -> latentExo
# if arrows==1
# add to KA
# if arrows==2
# stop('nonsense')
# 'one' -> latentEndo
# if arrows==1
# add to AL
# if arrows==2
# stop('nonsense')
# 'one' -> manifestExo
# if arrows==1
# add to TX
# if arrows==2
# stop('nonsense')
# 'one' -> manifestEndo
# if arrows==1
# add to TY
# if arrows==2
# stop('nonsense')
# 'one' -> 'one'
# stop('nonsense')
insertMeansPathLISREL <- function(path, TX, TY, KA, AL, manifest, latent){
mexog <- manifest$exogenous
mendo <- manifest$endogenous
lexog <- latent$exogenous
lendo <- latent$endogenous
allto <- path@to
allarrows <- path@arrows
allfree <- path@free
allvalues <- path@values
alllabels <- path@labels
alllbound <- path@lbound
allubound <- path@ubound
if (any(allarrows != 1)) {
stop(paste('The means path must be a single-headed arrow\n',
'path from "one" to variable(s)', omxQuotes(allto)), call. = FALSE)
}
for(i in 0:(length(allto) - 1)) {
to <- allto[[i %% length(allto) + 1]]
nextvalue <- allvalues[[i %% length(allvalues) + 1]]
nextfree <- allfree[[i %% length(allfree) + 1]]
nextlabel <- alllabels[[i %% length(alllabels) + 1]]
nextubound <- allubound[[i %% length(allubound) + 1]]
nextlbound <- alllbound[[i %% length(alllbound) + 1]]
if(to %in% mexog){ #Update TX
TX@free[to, 1] <- nextfree
TX@values[to, 1] <- nextvalue
TX@labels[to, 1] <- nextlabel
TX@ubound[to, 1] <- nextubound
TX@lbound[to, 1] <- nextlbound
} else if (to %in% mendo){ #Update TY
TY@free[to, 1] <- nextfree
TY@values[to, 1] <- nextvalue
TY@labels[to, 1] <- nextlabel
TY@ubound[to, 1] <- nextubound
TY@lbound[to, 1] <- nextlbound
} else if (to %in% lexog){ #Update KA
KA@free[to, 1] <- nextfree
KA@values[to, 1] <- nextvalue
KA@labels[to, 1] <- nextlabel
KA@ubound[to, 1] <- nextubound
KA@lbound[to, 1] <- nextlbound
} else if (to %in% lendo){ #Update AL
AL@free[to, 1] <- nextfree
AL@values[to, 1] <- nextvalue
AL@labels[to, 1] <- nextlabel
AL@ubound[to, 1] <- nextubound
AL@lbound[to, 1] <- nextlbound
} else {
stop("I can't figure out where to put the means paths.")
}
}
return(list(TX, TY, KA, AL))
}
updateLISRELMeans <- function(model, means){
if(!single.na(means[[1]])){
model[['TX']] <- means[[1]]
}
if(!single.na(means[[2]])){
model[['TY']] <- means[[2]]
}
if(!single.na(means[[3]])){
model[['KA']] <- means[[3]]
}
if(!single.na(means[[4]])){
model[['AL']] <- means[[4]]
}
return(model)
}
updateLISRELMatrices <- function(model, matrices){
if(!single.na(matrices$LX)){
model[['LX']] <- matrices$LX
}
if(!single.na(matrices$LY)){
model[['LY']] <- matrices$LY
}
if(!single.na(matrices$BE)){
model[['BE']] <- matrices$BE
}
if(!single.na(matrices$GA)){
model[['GA']] <- matrices$GA
}
if(!single.na(matrices$PH)){
model[['PH']] <- matrices$PH
}
if(!single.na(matrices$PS)){
model[['PS']] <- matrices$PS
}
if(!single.na(matrices$TD)){
model[['TD']] <- matrices$TD
}
if(!single.na(matrices$TE)){
model[['TE']] <- matrices$TE
}
if(!single.na(matrices$TH)){
model[['TH']] <- matrices$TH
}
return(model)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.