R/lav_syntax_mlist.R

In lavaan: Latent Variable Analysis

# 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) {
        stop("lavaan ERROR: 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
}