## File Name: tam_lavaanify.R
## File Version: 9.13
###################################################################
tam_lavaanify <- function( lavmodel )
{
require_namespace_msg("lavaan")
syn <- lavmodel
syn <- strsplit( syn, " " )[[1]]
syn <- syn[ syn !="" ]
syn <- gsub( ";", "\n", syn )
#*****
syn <- split_syn_string( syn, "\\n" )
syn[ syn=="\\n" ] <- "\n"
#***
dfr1 <- data.frame( "index"=1:length(syn), "syntax"=syn )
# look for specific strings and breaks
dfr1$eqind <- 0
N1 <- nrow(dfr1)
vv <- 1
for (ii in 1:N1){
dfr1[ ii, "eqind" ] <- vv
if ( length( grep( "\n", dfr1$syntax[ii] ) ) > 0 ){ vv <- vv + 1 }
}
syn0 <- lavmodel
#***************************************************************
# handling of guessing and slipping parameters
dfr1$guess_slip <- 0
ind <- grep( "\\?=", dfr1$syntax, perl=FALSE)
if ( length(ind) > 0 ){
dfr1$guess_slip[ ind ] <- 1
}
eqgroups <- dfr1$eqind[ which( dfr1$guess_slip==1 ) ]
dfr1$guess_slip[ dfr1$eqind %in% eqgroups ] <- 1
# create "normal" lavaan syntax
dfr2 <- dfr1[ dfr1$guess_slip==0, ]
lavmodel1 <- paste0( dfr2$syntax, collapse="")
lavpartable1 <- lavaan::lavaanify( as.character(lavmodel1 ), warn=FALSE, debug=FALSE,
fixed.x=FALSE)
res1 <- change.grep.lavpartable( lavpartable1 )
# create a new model syntax here!!!
if ( res1$changed ){
syn0 <- lavpartable2lavsyntax( res1$lavpartable )
lavpartable1 <- lavaan::lavaanify( as.character(syn0), warn=FALSE, debug=FALSE, fixed.x=FALSE)
}
# create lavaan parameter table for guessing/slipping parameters
dfr2 <- dfr1[ dfr1$guess_slip==1, ]
ug <- unique( dfr2$eqind)
vecstr <- c("\\+", "\\\n", "\\?=", "\\*" )
for (uu in ug){
syn.temp <- paste0( dfr2$syntax[ dfr2$eqind==uu ], collapse="")
syn.temp <- split_syn_string_vec( syn=syn.temp, vecstr=vecstr )
syn.temp[ syn.temp=="g1" ] <- "t1"
syn.temp[ syn.temp=="s1" ] <- "t2"
syn.temp[ syn.temp=="\\?=" ] <- "|"
syn.temp[ syn.temp=="\\+" ] <- "+"
syn.temp[ syn.temp=="\\*" ] <- "*"
syn.temp[ syn.temp=="\\\n" ] <- "\n"
syn.temp <- paste0( syn.temp, collapse="")
h1 <- lavaan::lavaanify( syn.temp)
h1 <- h1[ h1$op=="|", ]
h1$op <- "?="
h1[ h1$rhs=="t1","rhs"] <- "g1"
h1[ h1$rhs=="t2","rhs"] <- "s1"
h0 <- h1
h1$free <- h1$free + max(lavpartable1$free)
h1$free[ h0$free==0 ] <- 0
h1$id <- h1$id + max(lavpartable1$id)
lavpartable1 <- rbind( lavpartable1, h1 )
}
res <- list("lavpartable"=lavpartable1, "lavaan.syntax"=syn0 )
return(res)
}
##################################################################
TAM_lavaanify <- tam_lavaanify
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.