create.vechsR.R

create.vechsR <- function (A0, S0, F0 = NULL, Ax = NULL, Sx = NULL) {
    if (is.matrix(A0)) {
        A0 = as.mxMatrix(A0, name = "A0")
    }else{
        A0@name = "A0"
    } if (is.matrix(S0)) {
        S0 = as.mxMatrix(S0, name = "S0")
    }else{
        S0@name = "S0"
    }

    checkRAM(Amatrix = A0, Smatrix = S0, cor.analysis = TRUE)
    Iden = create.Fmatrix(rep(1, ncol(A0$values)), name = "Iden")

    if (is.null(F0)) {
        Fmatrix = Iden
        Fmatrix$name = "Fmatrix"
    }else{
        Fmatrix = as.mxMatrix(F0, name = "Fmatrix")
    }

    dv = apply(A0$free, 1, any)
    diag(S0$labels)[dv] = NA
    diag(S0$values)[dv] = 0
    diag(S0$free)[dv]   = FALSE
    Level = .pathLevels(A0)$DV
	
    if (is.null(Ax)) {
        Amatrix = mxAlgebra(A0, name = "Amatrix")
    }else{
        if (!is.list(Ax)) Ax = list(Ax)
        lapply(Ax, function(x) checkRAM(Amatrix = x))
        for (i in seq_len(length(Ax))) {
            index_mod = apply(Ax[[i]], 1:2, function(x) grepl("data", x))
            Atemp = A0
            Atemp$free = index_mod
            Atemp$labels[!index_mod] = NA
            text1 = paste0("A", i, " = Atemp; A", i, "$name = 'A",  i, "'")
            eval(parse(text = text1))
            text2 = paste0("A", i, "$labels = apply(A", i, "$labels, 1:2, function(x) {if (is.na(x)) NA else paste0(x,", "'_", i, "')})")
            eval(parse(text = text2))
            text3 = paste0("Ax", i, " = as.mxMatrix(Ax[[", i, "]], name='Ax", i, "')")
            eval(parse(text = text3))
        }
        text4 = paste0("A", seq_len(length(Ax)), "*Ax", seq_len(length(Ax)), collapse = " + ")
        text5 = paste0("Amatrix = mxAlgebra(A0 + ", text4, ", name='Amatrix')")
        eval(parse(text = text5))
    }
    if (is.null(Sx)) {
        SnoErr = mxAlgebra(S0, name = "SnoErr")
    }else{
        if (!is.list(Sx)) 
            Sx = list(Sx)
        lapply(Sx, function(x) checkRAM(Smatrix = x, cor.analysis = FALSE))

        for (i in seq_len(length(Sx))) {
            text1 = paste0("S", i, " = S0; S", i, "$name = 'S", i, "'")
            eval(parse(text = text1))
            text2 = paste0("S", i, "$labels = apply(S", i, "$labels, 1:2, function(x) {if (is.na(x)) NA else paste0(x,", "'_", i, "')})")
            eval(parse(text = text2))
            text3 = paste0("Sx", i, " = as.mxMatrix(Sx[[", i, "]], name='Sx", i, "')")
            eval(parse(text = text3))
        }
        text4 = paste0("S", seq_len(length(Sx)), "*Sx", seq_len(length(Sx)), collapse = " + ")
        text5 = paste0("SnoErr = mxAlgebra(S0 + ", text4, ", name='SnoErr')")
        eval(parse(text = text5))
    }
    invS0 = mxAlgebra(solve(Iden - Amatrix) %&% SnoErr, name = "invS0")
    for (i in 1:length(Level)) {
        text1 = paste0("F", i, " = as.mxMatrix(diag(Level[[", i, "]]), name='F", i, "')")
        eval(parse(text = text1))
        text2 = paste0("E", i, " = mxAlgebra(vec2diag(diag2vec(Iden-invS", i - 1, "))*F", i, ", name='E", i, "')")
        eval(parse(text = text2))
        text3 = paste("E", 1:i, sep = "", collapse = "+")
        text4 = paste("invS", i, " = mxAlgebra(solve(Iden-Amatrix)%&%(S0+", text3, "), name='invS", i, "')", sep = "")
        eval(parse(text = text4))
    }
    text5 = paste("E", seq_len(length(Level)), sep = "", collapse = "+")
    text6 = paste0("Smatrix = mxAlgebra(SnoErr+", text5, ", name='Smatrix')")
    eval(parse(text = text6))
    impliedR = eval(parse(text = "mxAlgebra((Fmatrix%*%solve(Iden-Amatrix))%&%Smatrix, name='impliedR')"))
    vechsR   = mxAlgebra(t(vechs(impliedR)), name = "vechsR")
    text7    = paste0("invS", seq_len(length(Level)), collapse = ",")
    text8    = paste0("E", seq_len(length(Level)), collapse = ",")
    text9    = paste0("F", seq_len(length(Level)), collapse = ",")
    text10   = paste0("list(Amatrix, Smatrix, Fmatrix, impliedR, vechsR, A0, S0, SnoErr, invS0, Iden,", text7, ",", text8, ",", text9)
    if (!is.null(Ax)) {
        text10 = paste0(text10, ",", paste0("A", seq_len(length(Ax)), collapse = ","), ",", paste0("Ax", seq_len(length(Ax)), collapse = ","))
    }
    if (!is.null(Sx)) {
        text10 = paste0(text10, ",", paste0("S", seq_len(length(Sx)), collapse = ","), ",", paste0("Sx", seq_len(length(Sx)), collapse = ","))
    }
    text10 = paste0(text10, ")")
    out    = eval(parse(text = text10))
    names(out) = sapply(out, function(x) x$name)
    out
}