Nothing
# generate lavaan model syntax from a list of model matrices
#
# YR -- 4 Dec 2021
#
# - currently for a single group/level only
# - continuous setting only; the model matrices are LAMBDA, PSI, THETA and
# optionally BETA
#
# we return a single string
lav_syntax_mlist <- function(MLIST, ov.prefix = "y", lv.prefix = "f",
include.values = TRUE) {
# model matrices
LAMBDA <- MLIST$lambda
THETA <- MLIST$theta
PSI <- MLIST$psi
BETA <- MLIST$beta
# check prefix
if (ov.prefix == lv.prefix) {
lav_msg_stop(gettext("ov.prefix can not be the same as lv.prefix"))
}
header <- "# syntax generated by lav_syntax_mlist()"
# LAMBDA
if (!is.null(LAMBDA)) {
IDXV <- row(LAMBDA)[(LAMBDA != 0)]
IDXF <- col(LAMBDA)[(LAMBDA != 0)]
# lambda.txt <- character(nfactors)
# for(f in seq_len(nfactors)) {
# var.idx <- which(LAMBDA[,f] != 0.0)
# lambda.vals <- LAMBDA[var.idx, f]
# lambda.txt[f] <- paste( paste0(lv.prefix, f), "=~",
# paste(lambda.vals, "*",
# paste0(ov.prefix, var.idx),
# sep = "", collapse = " + ") )
# }
nel <- length(IDXF)
lambda.txt <- character(nel)
for (i in seq_len(nel)) {
if (include.values) {
lambda.txt[i] <- paste0(
paste0(lv.prefix, IDXF[i]), " =~ ",
LAMBDA[IDXV[i], IDXF[i]], "*",
paste0(ov.prefix, IDXV[i])
)
} else {
lambda.txt[i] <- paste0(
paste0(lv.prefix, IDXF[i]), " =~ ",
paste0(ov.prefix, IDXV[i])
)
}
}
} else {
lambda.txt <- character(0L)
}
# THETA
if (!is.null(THETA)) {
IDX1 <- row(THETA)[(THETA != 0) & upper.tri(THETA, diag = TRUE)]
IDX2 <- col(THETA)[(THETA != 0) & upper.tri(THETA, diag = TRUE)]
nel <- length(IDX1)
theta.txt <- character(nel)
for (i in seq_len(nel)) {
if (include.values) {
theta.txt[i] <- paste0(
paste0(ov.prefix, IDX1[i]), " ~~ ",
THETA[IDX1[i], IDX2[i]], "*",
paste0(ov.prefix, IDX2[i])
)
} else {
theta.txt[i] <- paste0(
paste0(ov.prefix, IDX1[i]), " ~~ ",
paste0(ov.prefix, IDX2[i])
)
}
}
} else {
theta.txt <- character(0L)
}
# PSI
if (!is.null(PSI)) {
IDX1 <- row(PSI)[(PSI != 0) & upper.tri(PSI, diag = TRUE)]
IDX2 <- col(PSI)[(PSI != 0) & upper.tri(PSI, diag = TRUE)]
nel <- length(IDX1)
psi.txt <- character(nel)
for (i in seq_len(nel)) {
if (include.values) {
psi.txt[i] <- paste0(
paste0(lv.prefix, IDX1[i]), " ~~ ",
PSI[IDX1[i], IDX2[i]], "*",
paste0(lv.prefix, IDX2[i])
)
} else {
psi.txt[i] <- paste0(
paste0(lv.prefix, IDX1[i]), " ~~ ",
paste0(lv.prefix, IDX2[i])
)
}
}
} else {
psi.txt <- character(0L)
}
# BETA
if (!is.null(BETA)) {
IDX1 <- row(BETA)[(BETA != 0)]
IDX2 <- col(BETA)[(BETA != 0)]
nel <- length(IDX1)
beta.txt <- character(nel)
for (i in seq_len(nel)) {
if (include.values) {
beta.txt[i] <- paste0(
paste0(lv.prefix, IDX1[i]), " ~ ",
BETA[IDX1[i], IDX2[i]], "*",
paste0(lv.prefix, IDX2[i])
)
} else {
beta.txt[i] <- paste0(
paste0(lv.prefix, IDX1[i]), " ~ ",
paste0(lv.prefix, IDX2[i])
)
}
}
} else {
beta.txt <- character(0L)
}
# assemble
syntax <- paste(c(header, lambda.txt, theta.txt, psi.txt, beta.txt, ""),
collapse = "\n"
)
syntax
}
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.