Nothing
## ----include = FALSE----------------------------------------------------------
is_CRAN <- !identical(Sys.getenv("NOT_CRAN"), "true")
if (!is_CRAN) {
options(mc.cores = parallel::detectCores())
} else {
knitr::opts_chunk$set(eval = FALSE)
knitr::knit_hooks$set(evaluate.inline = function(x, envir) x)
}
## -----------------------------------------------------------------------------
library(OpenMx)
data(myFADataRaw)
dataRawOneFactor <- mxData( observed=myFADataRaw[,c("x1","x2","x3","x4","x5","x6")], type="raw" )
## -----------------------------------------------------------------------------
myFADataCov<-matrix(
c(0.997, 0.642, 0.611, 0.672, 0.637, 0.677,
0.642, 1.025, 0.608, 0.668, 0.643, 0.676,
0.611, 0.608, 0.984, 0.633, 0.657, 0.626,
0.672, 0.668, 0.633, 1.003, 0.676, 0.665,
0.637, 0.643, 0.657, 0.676, 1.028, 0.654,
0.677, 0.676, 0.626, 0.665, 0.654, 1.020),
nrow=6,
dimnames=list(
c("x1","x2","x3","x4","x5","x6"),
c("x1","x2","x3","x4","x5","x6"))
)
myFADataMeans <- c(2.988, 3.011, 2.986, 3.053, 3.016, 3.010)
names(myFADataMeans) <- c("x1","x2","x3","x4","x5","x6")
dataCovOneFactor <- mxData( observed=myFADataCov, type="cov", numObs=500,
mean=myFADataMeans )
## -----------------------------------------------------------------------------
dataRawTwoFactor <- mxData( observed=myFADataRaw[,c("x1","x2","x3","y1","y2","y3")], type="raw" )
## -----------------------------------------------------------------------------
twoFactorCov <- matrix(
c(0.997, 0.642, 0.611, 0.342, 0.299, 0.337,
0.642, 1.025, 0.608, 0.273, 0.282, 0.287,
0.611, 0.608, 0.984, 0.286, 0.287, 0.264,
0.342, 0.273, 0.286, 0.993, 0.472, 0.467,
0.299, 0.282, 0.287, 0.472, 0.978, 0.507,
0.337, 0.287, 0.264, 0.467, 0.507, 1.059),
nrow=6,
dimnames=list(
c("x1", "x2", "x3", "y1", "y2", "y3"),
c("x1", "x2", "x3", "y1", "y2", "y3")),
)
twoFactorMeans <- c(2.988, 3.011, 2.986, 2.955, 2.956, 2.967)
names(twoFactorMeans) <- c("x1", "x2", "x3", "y1", "y2", "y3")
# Prepare Data
# -----------------------------------------------------------------------------
dataCovTwoFactor <- mxData( observed=twoFactorCov, type="cov", numObs=500, means=twoFactorMeans )
## -----------------------------------------------------------------------------
latentVars <- "F1"
manifestVars=c("x1","x2","x3","x4","x5","x6")
## -----------------------------------------------------------------------------
# latent variance
latVar <- mxPath( from="F1", arrows=2,
free=TRUE, values=1, labels ="varF1" )
## -----------------------------------------------------------------------------
# residual variances
resVars <- mxPath( from=c("x1","x2","x3","x4","x5","x6"), arrows=2,
free=TRUE, values=c(1,1,1,1,1,1),
labels=c("e1","e2","e3","e4","e5","e6") )
## -----------------------------------------------------------------------------
# factor loadings
facLoads <- mxPath( from="F1", to=c("x1","x2","x3","x4","x5","x6"), arrows=1,
free=c(FALSE,TRUE,TRUE,TRUE,TRUE,TRUE), values=c(1,1,1,1,1,1),
labels =c("l1","l2","l3","l4","l5","l6") )
## -----------------------------------------------------------------------------
# means
means <- mxPath( from="one", to=c("x1","x2","x3","x4","x5","x6","F1"), arrows=1,
free=c(T,T,T,T,T,T,FALSE), values=c(1,1,1,1,1,1,0),
labels =c("meanx1","meanx2","meanx3","meanx4","meanx5","meanx6",NA) )
## -----------------------------------------------------------------------------
oneFactorPathModel <- mxModel("Common Factor Model Path Specification", type="RAM",
manifestVars=c("x1","x2","x3","x4","x5","x6"), latentVars="F1",
dataRawOneFactor, resVars, latVar, facLoads, means)
## -----------------------------------------------------------------------------
manifestVars <- c("x1","x2","x3","y1","y2","y3")
latentVars <- c("F1","F2")
# residual variances
resVars <- mxPath( from=c("x1", "x2", "x3", "y1", "y2", "y3"), arrows=2,
free=TRUE, values=c(1,1,1,1,1,1),
labels=c("e1","e2","e3","e4","e5","e6") )
# means
means <- mxPath( from="one", to=c("x1","x2","x3","y1","y2","y3","F1","F2"),
arrows=1,
free=c(T,T,T,T,T,T,F,F), values=c(1,1,1,1,1,1,0,0),
labels=c("meanx1","meanx2","meanx3",
"meany1","meany2","meany3",NA,NA) )
## -----------------------------------------------------------------------------
# latent variances and covariance
latVars <- mxPath( from=c("F1","F2"), arrows=2, connect="unique.pairs",
free=TRUE, values=c(1,.5,1), labels=c("varF1","cov","varF2") )
## -----------------------------------------------------------------------------
print(latVars)
## -----------------------------------------------------------------------------
# factor loadings for x variables
facLoadsX <- mxPath( from="F1", to=c("x1","x2","x3"), arrows=1,
free=c(F,T,T), values=c(1,1,1), labels=c("l1","l2","l3") )
# factor loadings for y variables
facLoadsY <- mxPath( from="F2", to=c("y1","y2","y3"), arrows=1,
free=c(F,T,T), values=c(1,1,1), labels=c("l4","l5","l6") )
## -----------------------------------------------------------------------------
twoFactorPathModel <- mxModel("Two Factor Model Path Specification", type="RAM",
manifestVars=c("x1", "x2", "x3", "y1", "y2", "y3"),
latentVars=c("F1","F2"),
dataRawTwoFactor, resVars, latVars, facLoadsX, facLoadsY, means)
## -----------------------------------------------------------------------------
# asymmetric paths
matrA <- mxMatrix( type="Full", nrow=7, ncol=7,
free= c(F,F,F,F,F,F,F,
F,F,F,F,F,F,T,
F,F,F,F,F,F,T,
F,F,F,F,F,F,T,
F,F,F,F,F,F,T,
F,F,F,F,F,F,T,
F,F,F,F,F,F,F),
values=c(0,0,0,0,0,0,1,
0,0,0,0,0,0,1,
0,0,0,0,0,0,1,
0,0,0,0,0,0,1,
0,0,0,0,0,0,1,
0,0,0,0,0,0,1,
0,0,0,0,0,0,0),
labels=c(NA,NA,NA,NA,NA,NA,"l1",
NA,NA,NA,NA,NA,NA,"l2",
NA,NA,NA,NA,NA,NA,"l3",
NA,NA,NA,NA,NA,NA,"l4",
NA,NA,NA,NA,NA,NA,"l5",
NA,NA,NA,NA,NA,NA,"l6",
NA,NA,NA,NA,NA,NA,NA),
byrow=TRUE, name="A" )
## -----------------------------------------------------------------------------
# symmetric paths
matrS <- mxMatrix( type="Symm", nrow=7, ncol=7,
free= c(T,F,F,F,F,F,F,
F,T,F,F,F,F,F,
F,F,T,F,F,F,F,
F,F,F,T,F,F,F,
F,F,F,F,T,F,F,
F,F,F,F,F,T,F,
F,F,F,F,F,F,T),
values=c(1,0,0,0,0,0,0,
0,1,0,0,0,0,0,
0,0,1,0,0,0,0,
0,0,0,1,0,0,0,
0,0,0,0,1,0,0,
0,0,0,0,0,1,0,
0,0,0,0,0,0,1),
labels=c("e1",NA, NA, NA, NA, NA, NA,
NA, "e2", NA, NA, NA, NA, NA,
NA, NA, "e3", NA, NA, NA, NA,
NA, NA, NA, "e4", NA, NA, NA,
NA, NA, NA, NA, "e5", NA, NA,
NA, NA, NA, NA, NA, "e6", NA,
NA, NA, NA, NA, NA, NA, "varF1"),
byrow=TRUE, name="S" )
## -----------------------------------------------------------------------------
# filter matrix
matrF <- mxMatrix( type="Full", nrow=6, ncol=7,
free=FALSE,
values=c(1,0,0,0,0,0,0,
0,1,0,0,0,0,0,
0,0,1,0,0,0,0,
0,0,0,1,0,0,0,
0,0,0,0,1,0,0,
0,0,0,0,0,1,0),
byrow=TRUE, name="F" )
## -----------------------------------------------------------------------------
# means
matrM <- mxMatrix( type="Full", nrow=1, ncol=7,
free=c(T,T,T,T,T,T,F),
values=c(1,1,1,1,1,1,0),
labels=c("meanx1","meanx2","meanx3",
"meanx4","meanx5","meanx6",NA),
name="M" )
## -----------------------------------------------------------------------------
exp <- mxExpectationRAM("A","S","F","M",
dimnames=c(manifestVars, latentVars))
funML <- mxFitFunctionML()
## -----------------------------------------------------------------------------
oneFactorMatrixModel <- mxModel("Common Factor Model Matrix Specification",
dataRawOneFactor, matrA, matrS, matrF, matrM, exp, funML)
## -----------------------------------------------------------------------------
# asymmetric paths
matrA <- mxMatrix( type="Full", nrow=8, ncol=8,
free= c(F,F,F,F,F,F,F,F,
F,F,F,F,F,F,T,F,
F,F,F,F,F,F,T,F,
F,F,F,F,F,F,F,F,
F,F,F,F,F,F,F,T,
F,F,F,F,F,F,F,T,
F,F,F,F,F,F,F,F,
F,F,F,F,F,F,F,F),
values=c(0,0,0,0,0,0,1,0,
0,0,0,0,0,0,1,0,
0,0,0,0,0,0,1,0,
0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0),
labels=c(NA,NA,NA,NA,NA,NA,"l1",NA,
NA,NA,NA,NA,NA,NA,"l2",NA,
NA,NA,NA,NA,NA,NA,"l3",NA,
NA,NA,NA,NA,NA,NA,NA,"l4",
NA,NA,NA,NA,NA,NA,NA,"l5",
NA,NA,NA,NA,NA,NA,NA,"l6",
NA,NA,NA,NA,NA,NA,NA,NA,
NA,NA,NA,NA,NA,NA,NA,NA),
byrow=TRUE, name="A" )
## -----------------------------------------------------------------------------
# symmetric paths
matrS <- mxMatrix( type="Symm", nrow=8, ncol=8,
free= c(T,F,F,F,F,F,F,F,
F,T,F,F,F,F,F,F,
F,F,T,F,F,F,F,F,
F,F,F,T,F,F,F,F,
F,F,F,F,T,F,F,F,
F,F,F,F,F,T,F,F,
F,F,F,F,F,F,T,T,
F,F,F,F,F,F,T,T),
values=c(1,0,0,0,0,0,0,0,
0,1,0,0,0,0,0,0,
0,0,1,0,0,0,0,0,
0,0,0,1,0,0,0,0,
0,0,0,0,1,0,0,0,
0,0,0,0,0,1,0,0,
0,0,0,0,0,0,1,.5,
0,0,0,0,0,0,.5,1),
labels=c("e1",NA, NA, NA, NA, NA, NA, NA,
NA, "e2", NA, NA, NA, NA, NA, NA,
NA, NA, "e3", NA, NA, NA, NA, NA,
NA, NA, NA, "e4", NA, NA, NA, NA,
NA, NA, NA, NA, "e5", NA, NA, NA,
NA, NA, NA, NA, NA, "e6", NA, NA,
NA, NA, NA, NA, NA, NA,"varF1","cov",
NA, NA, NA, NA, NA, NA,"cov","varF2"),
byrow=TRUE, name="S" )
## -----------------------------------------------------------------------------
matrF <- mxMatrix( type="Full", nrow=6, ncol=8,
free=FALSE,
values=c(1,0,0,0,0,0,0,0,
0,1,0,0,0,0,0,0,
0,0,1,0,0,0,0,0,
0,0,0,1,0,0,0,0,
0,0,0,0,1,0,0,0,
0,0,0,0,0,1,0,0),
byrow=TRUE, name="F" )
matrM <- mxMatrix( type="Full", nrow=1, ncol=8,
free=c(T,T,T,T,T,T,F,F),
values=c(1,1,1,1,1,1,0,0),
labels=c("meanx1","meanx2","meanx3",
"meanx4","meanx5","meanx6",NA,NA),
name="M" )
## -----------------------------------------------------------------------------
exp <- mxExpectationRAM("A","S","F","M",
dimnames=c(manifestVars, latentVars))
funML <- mxFitFunctionML()
twoFactorMatrixModel <- mxModel("Two Factor Model Matrix Specification",
dataRawTwoFactor, matrA, matrS, matrF, matrM, exp, funML)
## -----------------------------------------------------------------------------
twoFactorMatrixFit <- mxRun(twoFactorMatrixModel)
## -----------------------------------------------------------------------------
summary(twoFactorMatrixFit)
## ----eval=FALSE---------------------------------------------------------------
# output(twoFactorMatrixFit)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.