From b3b1ac74db6741244543a555e641fce70dc67cea Mon Sep 17 00:00:00 2001 From: Sacha Epskamp Date: Fri, 5 Apr 2019 14:40:03 +0000 Subject: [PATCH] version 1.1.1 --- DESCRIPTION | 19 +++++++--- MD5 | 24 +++++++----- NAMESPACE | 10 ++++- NEWS | 3 ++ R/00classes.R | 4 +- R/cvregsemplot.R | 89 ++++++++++++++++++++++++++++++++++++++++++++ R/lavaan.R | 17 +++++++-- R/lists.R | 6 +-- R/mplus.R | 36 ++++++++++++------ R/regsemplot.R | 86 ++++++++++++++++++++++++++++++++++++++++++ R/semPaths.R | 9 +++-- man/cvregsemplot.Rd | 66 ++++++++++++++++++++++++++++++++ man/modelMatrices.Rd | 5 +-- man/regsemplot.Rd | 62 ++++++++++++++++++++++++++++++ man/semPlotModel.Rd | 5 ++- 15 files changed, 394 insertions(+), 47 deletions(-) create mode 100644 R/cvregsemplot.R create mode 100644 R/regsemplot.R create mode 100644 man/cvregsemplot.Rd create mode 100644 man/regsemplot.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 9b39fd3..084847a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,20 +2,29 @@ Package: semPlot Type: Package Title: Path Diagrams and Visual Analysis of Various SEM Packages' Output -Version: 1.1 -Author: Sacha Epskamp, with contributions from Simon Stuber +Version: 1.1.1 +Authors@R: c( + person("Sacha", "Epskamp", email = "mail@sachaepskamp.com",role = c("aut", "cre")), + person("Simon", "Stuber", role = c("ctb")), + person("Jason", "Nak", role = c("ctb")), + person("Myrthe", "Veenman", role = c("ctb")) + ) Maintainer: Sacha Epskamp Depends: R (>= 2.15.0) Suggests: MplusAutomation (>= 0.5-3) Imports: qgraph (>= 1.2.4), lavaan (>= 0.5-11), sem (>= 3.1-0), plyr, XML, igraph (>= 0.6-3), lisrelToR, rockchalk, colorspace, - corpcor, methods, semTools, OpenMx + corpcor, methods, semTools, OpenMx, regsem ByteCompile: yes Description: Path diagrams and visual analysis of various SEM packages' output. URL: https://github.com/SachaEpskamp/semPlot License: GPL-2 LazyLoad: yes NeedsCompilation: no -Packaged: 2017-03-27 11:23:02 UTC; sachaepskamp +Packaged: 2019-04-05 14:51:15 UTC; sachaepskamp +Author: Sacha Epskamp [aut, cre], + Simon Stuber [ctb], + Jason Nak [ctb], + Myrthe Veenman [ctb] Repository: CRAN -Date/Publication: 2017-03-27 13:56:21 UTC +Date/Publication: 2019-04-05 15:40:03 UTC diff --git a/MD5 b/MD5 index e5e9559..3bf5d29 100644 --- a/MD5 +++ b/MD5 @@ -1,37 +1,39 @@ ff547ababc85108875b8e8f94239d4dd *COPYING -2fee16c126d42660baf51724b240b4e2 *DESCRIPTION -96cd52570a9a1c4863716d7e1a52510d *NAMESPACE -de486ac1f425b04fbb403fb1a071142b *NEWS -4c7776f3a60c386fa932c50f46009977 *R/00classes.R +6c713ff4fab0124861fa5288cf1aa6a0 *DESCRIPTION +d2155d739b9edf23acb03d29c0167560 *NAMESPACE +a345e358fd661ef77d9b04fb4a1d497b *NEWS +6331dde1ac9c8dbbe8e76c99bee595f2 *R/00classes.R 579e8b2641f3e8a5178eba4a297314f1 *R/Imin.R 8c3648e41405f1aa7f68faffe5ba2efa *R/IntInNode.r f00557c10fd736d2f515eec0b22c285f *R/OpenMx.R 5b72ddd986870bd8e073676db942234a *R/Pars2Matrix.R b92da836d47ecc0b7f2b48815e406c19 *R/amos.R +a12d237e8ab65edc2757040b398eccb4 *R/cvregsemplot.R 89ff726b3c2aa9772615acc067622404 *R/defExo.R a148129fc1a655b4f125a49358697e7b *R/editFuns.R 8f3707a6268747000876753d89cc25d9 *R/factanal.R f5fb2ffd916521a1f63d47490c7a03c7 *R/glm.R 5475c928a8b21487dfb7208eba80a749 *R/greplVarType.R f21b6d9493451ecdbe3b98974bc33bab *R/isColor.R -b5888bd25f1e83dcdef363ad5b51762e *R/lavaan.R +e62786174242a3e3a758b5405aef918b *R/lavaan.R db340141043be8e68780902e1465ef10 *R/lavaanModel.R 5adb76ba7df5c50bdf532aacc49424be *R/lisrelMat2RAM.R 1221e8a125bb29366df794486075aa28 *R/lisrelModel.R -9712136db8a6c349c63b2068d79de141 *R/lists.R +6c9247a19b360e63d9ab2f619e60ae57 *R/lists.R b067b152cf18742ea06c9cc0b4e2900c *R/loadings.R 7f1a3ef88b527ae5b1495e3fe8834813 *R/mappingfuns.R 4d17fa82fa3781ff1ca86fc3d1f4e18b *R/modelMatrices.R -ba29d86c283bb917427f0fd91b1178f6 *R/mplus.R +79d6e5374d64dc7a6450693de1b96f5b *R/mplus.R 0e93679cadc5ac57360bbe1a36b1dbdf *R/onyx.R 69629ec92e90326d3aa630ac725cbb41 *R/operators.R 7622d921838cf952fbeaabe3caa5e894 *R/principal.R b05fdedba97ed0e1a86f91ab12565180 *R/princomp.R c5a5eba09d49930b6e0160a7b9ec6925 *R/ramModel.R +676e244f3f1fa6c1f5bd838b8c142916 *R/regsemplot.R 19b287a454a13bda0aaeef4094a41c4d *R/sem.R 2f61fd62584bf9c98bba51b97d80d3f4 *R/semCors.R 3b788e07050739e522904acf5c183363 *R/semMatrixAlgebra.R -f8cb61b043a65c952770b91b3fcfca4e *R/semPaths.R +54a416fe9b76c32e914eb46bb9c1ffc8 *R/semPaths.R 2f263f9f0d9b3323ad2cdac9132664e4 *R/semPathsHelperFuns.R 492f9b0d221bdcc8601974802df5bbc1 *R/semSyntax.R 685428c6eeee5aaca688f466d517c4f2 *R/semspec.R @@ -41,16 +43,18 @@ eb883c696362d7353bd74cb606fa6e23 *R/standardizeRAM_2.R f9721ef43e5f912ddea844bafbf43ec5 *README 600343cabf23256660d9adc754f3f6e4 *inst/COPYRIGHTS fe8f33483833e151113dced7d32ca2ff *man/Imin.Rd +6485f1332059c3deb3601786ff6cafb3 *man/cvregsemplot.Rd dfd6670b4e9fc9fb2e63169fbcdf5783 *man/edits.Rd c55952e755b8121768815bb2634be5f1 *man/lisrelModel.Rd -be9227da2ee17e68b646df700c4ce800 *man/modelMatrices.Rd +ac4887c32ddfead1ecf9d1bec73df9a8 *man/modelMatrices.Rd ee8008d40ba3d4c6391a4d44c8c95c56 *man/ramModel.Rd +916a25b62e55877c4a1371a7185276bd *man/regsemplot.Rd 5c6f88a5afd453c7a93137e70ecb8732 *man/semCors.Rd 512a8e0140b61ad7ff8bf3bca8038d8e *man/semMatrixAlgebra.Rd 7cebc5ca573b167c6bb6f26241e7f585 *man/semPaths.Rd 7fcdabc526259cdaa114ff3b2fb9f6aa *man/semPlot-package.Rd e5996043cd0f0d7f8bc03b8dd621c366 *man/semPlotModel-class.Rd -22750cd7bc8ba837d473b9647350af2a *man/semPlotModel.Rd +c4fced0a3e226caed2d7422da3483664 *man/semPlotModel.Rd 5a26e6059f4f9f0a488631d89df21a97 *man/semPlotModel.S4-methods.Rd 115cd8caf7dc32804aad0cf9cb3a86d0 *man/semSyntax.Rd 98aebe08c8a4c48a6c36c81ec0b37f39 *man/tricks.Rd diff --git a/NAMESPACE b/NAMESPACE index 677d89b..6440622 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,4 +1,5 @@ -export(semPaths,semPlotModel,semCors,lisrelModel,ramModel,semSyntax,semMatrixAlgebra,modelMatrices,Imin,semPlotModel_lavaanModel) +export(semPaths,semPlotModel,semCors,lisrelModel,ramModel,semSyntax, + semMatrixAlgebra,modelMatrices,Imin,semPlotModel_lavaanModel) # export Classes exportClasses( @@ -26,6 +27,8 @@ S3method(semPlotModel,msemObjectiveML) export(semPlotModel_Onyx) export(semPlotModel_Amos) export(exo,"exo<-",endo,"endo<-",lat,"lat<-",man,"man<-") +S3method(semPlotModel,regsem) +S3method(semPlotModel,cvregsem) # importFrom(MplusAutomation,"readModels") importFrom(sem,"sem","standardizedCoefficients","specifyModel") @@ -33,6 +36,7 @@ importFrom(lavaan,"lavaan","cfa","standardizedSolution", "standardizedsolution", importClassesFrom(lavaan,"lavaan") importFrom(stats,"factanal") importFrom(rockchalk,standardize) +importFrom(regsem, "regsem","cv_regsem") import(plyr) import(lisrelToR) import(XML) @@ -47,4 +51,6 @@ importFrom(corpcor,"pseudoinverse") importFrom("graphics", "lines", "par", "text") importFrom("stats", "ave", "coef", "cov", "cov2cor", "loadings", "median", "pnorm", "weighted.mean") - importFrom("utils", "packageDescription") \ No newline at end of file + importFrom("utils", "packageDescription") + + \ No newline at end of file diff --git a/NEWS b/NEWS index cf78fe2..7309df8 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,6 @@ +Changes in Version 1.1.1 + o regsem and cv_regsem support added, thanks to Myrthe Veenman and Jason Nak! + Changes in Version 1.1 o Fixed a bug with lavaan input o Fixed a bug with OpenMx 2 input diff --git a/R/00classes.R b/R/00classes.R index a4069d5..43612bd 100644 --- a/R/00classes.R +++ b/R/00classes.R @@ -99,7 +99,7 @@ semPlotModel.default <- function(object,...) head <- readLines(object, 10) if (any(grepl("mplus",head,ignore.case=TRUE))) { - return(semPlotModel.mplus.model(object)) + return(semPlotModel.mplus.model(object,...)) } if (any(grepl("l\\s*i\\s*s\\s*r\\s*e\\s*l",head,ignore.case=TRUE))) @@ -112,7 +112,7 @@ semPlotModel.default <- function(object,...) mod <- try(semPlotModel_lavaanModel(object,...),silent=TRUE) if (!"try-error"%in%class(mod)) return(mod) - mod <- try(semPlotModel.mplus.model(object),silent=TRUE) + mod <- try(semPlotModel.mplus.model(object,...),silent=TRUE) if (!"try-error"%in%class(mod)) return(mod) mod <- try(semPlotModel(readLisrel(object)),silent=TRUE) diff --git a/R/cvregsemplot.R b/R/cvregsemplot.R new file mode 100644 index 0000000..e50520c --- /dev/null +++ b/R/cvregsemplot.R @@ -0,0 +1,89 @@ + + +semPlotModel.cvregsem <- function(object,model,...){ + if (missing(model)){ + stop("Please supply lavaan model with 'model' argument!") + } + ## Save parts of the output in objects + object1 <- object # parameters + object2 <- model@ParTable # lavaan parameters + varnames <- unique(c(object2$lhs, object2$rhs)) # all names + mannames <- model@Model@dimNames[[1]][1] # manifest variables + names(varnames) <- 'name' + names(mannames) <- 'manifest' + + '%!in%' <- function(x,y)!('%in%'(x,y)) + + ## Add the fixed relations to the parameter estimates of regsem + namelist <- strsplit(names(object1$final_pars)," ") # split names and operators + inout <- data.frame(1,2) + for(i in 1:length(namelist)){ + inout[i,1] <- namelist[[i]][1] + inout[i,2] <- namelist[[i]][3] + } # create data frame of regsem variables + + int <- data.frame(1,2) + for(i in 1:length(object2$lhs)){ + int[i,1] <- ifelse(object2$op[i]=="~"|object2$op[i]=="~1",object2$rhs[i],object2$lhs[i]) + int[i,2] <- ifelse(object2$op[i]=="~"|object2$op[i]=="~1",object2$lhs[i],object2$rhs[i]) + } # create data frame of lavaan variables + + ## paste together + pinout <- with(inout, paste0(X1, X2)) + pint <- with(int, paste0(X1, X2)) + + counter <- 0 + for(i in 1:length(object2$free)){ # if free before, + if(object2$free[i] == 0){ + object1$regest[i] <- 1 + counter = counter + 1 + } else{ + object1$regest[i] <- object1$final_pars[i - counter] + } + } # match regsem estimates with lavaan variables, set fixed to 1 + + + ## Create a S4 list + semModel <- new("semPlotModel") + + ## Create a Pars data frame + semModel@Pars <- data.frame( + label = rep("", length(object2$id)), + lhs = ifelse(object2$op=="~"|object2$op=="~1",object2$rhs,object2$lhs), # first went from left to right without checking relationship + edge = "--", + rhs = ifelse(object2$op=="~"|object2$op=="~1",object2$lhs,object2$rhs), + est = object1$regest, # check if we should take estimates from other model, if estimates are same as in regsem + std = NA, + group = object2$group, + fixed = object2$free == 0, + par = object2$free, + stringsAsFactors=FALSE) + row.names(semModel@Pars) <- 1:length(object2$id) + + ## translate operators + semModel@Pars$edge[object2$op=="~~"] <- "<->" + semModel@Pars$edge[object2$op=="~*~"] <- "<->" + semModel@Pars$edge[object2$op=="~"] <- "~>" + semModel@Pars$edge[object2$op=="=~"] <- "->" + semModel@Pars$edge[object2$op=="~1"] <- "int" + semModel@Pars$edge[grepl("\\|",object2$op)] <- "|" + + semModel@Pars <- semModel@Pars[!object2$op%in%c(':=','<','>','==','|','<', '>'),] + + ## Create a vars data frame + semModel@Vars <- data.frame( + name = varnames, + manifest = varnames[1:length(varnames)] %in% mannames$manifest[1:length(mannames$manifest)], + exogenous = NA, + stringsAsFactors = FALSE + ) + + ## Miscellaneous data frames + semModel@Thresholds <- data.frame() + semModel@ObsCovs <- list() + semModel@ImpCovs <- list() + semModel@Computed <- FALSE + semModel@Original <- list(object) + + return(semModel) +} diff --git a/R/lavaan.R b/R/lavaan.R index aa8b525..9e7895d 100644 --- a/R/lavaan.R +++ b/R/lavaan.R @@ -9,8 +9,10 @@ ## EXTRACT MODEL ### setMethod("semPlotModel_S4",signature("lavaan"),function(object){ + if (class(object)=="blavaan") class(object) <- 'lavaan' if (class(object)!="lavaan") stop("Input must me a 'lavaan' object") + # Extract parameter estimates: pars <- parameterEstimates(object,standardized=TRUE) list <- inspect(object,"list") @@ -76,11 +78,17 @@ setMethod("semPlotModel_S4",signature("lavaan"),function(object){ exogenous = NA, stringsAsFactors=FALSE) - if (!is.null(object@SampleStats@res.cov[[1]])){ - semModel@ObsCovs <- object@SampleStats@res.cov + if (!is.null(object@SampleStats@res.cov) && !length(object@SampleStats@res.cov) == 0){ + if (!is.null(object@SampleStats@res.cov[[1]])){ + semModel@ObsCovs <- object@SampleStats@res.cov + } else { + semModel@ObsCovs <- object@SampleStats@cov + } } else { - semModel@ObsCovs <- object@SampleStats@cov - } + semModel@ObsCovs <- list(matrix(NA, + length(varNames),length(varNames))) + } + names(semModel@ObsCovs) <- object@Data@group.label for (i in 1:length(semModel@ObsCovs)) @@ -90,6 +98,7 @@ setMethod("semPlotModel_S4",signature("lavaan"),function(object){ semModel@ImpCovs <- object@Fit@Sigma.hat names(semModel@ImpCovs) <- object@Data@group.label + for (i in 1:length(semModel@ImpCovs)) { rownames(semModel@ImpCovs[[i]]) <- colnames(semModel@ImpCovs[[i]]) <- object@Data@ov.names[[i]] diff --git a/R/lists.R b/R/lists.R index 366a1e1..07e89b1 100644 --- a/R/lists.R +++ b/R/lists.R @@ -1,7 +1,7 @@ -semPlotModel.list <- function(object, ...) +semPlotModel.list <- function(object,...) { - if ("mplus.model"%in%class(object)) return(semPlotModel.mplus.model(object)) + if ("mplus.model"%in%class(object)) return(semPlotModel.mplus.model(object,...)) mod <- try(semPlotModel_lavaanModel(object,...),silent=TRUE) if (!"try-error"%in%class(mod)) return(mod) @@ -14,4 +14,4 @@ semPlotModel.list <- function(object, ...) for (i in 2:length(object)) Res <- Res + object[[i]] return(Res) } else return(object) -} \ No newline at end of file +} diff --git a/R/mplus.R b/R/mplus.R index 4f13bea..1e73912 100644 --- a/R/mplus.R +++ b/R/mplus.R @@ -7,7 +7,7 @@ readModels <- NULL -semPlotModel.mplus.model <- function (object,mplusStd=c("std", "stdy", "stdxy"),...) +semPlotModel.mplus.model <- function (object,mplusStd=c("std", "stdy", "stdyx"),...) { mplusStd <- match.arg(mplusStd) @@ -80,6 +80,13 @@ semPlotModel.mplus.model <- function (object,mplusStd=c("std", "stdy", "stdxy"), } } + # Only find fixed if SE is present: + if (!is.null(parsUS$se)){ + fixed <- parsUS$se==0 + } else { + fixed <- FALSE + } + # Define Pars: Pars <- data.frame( label = "", @@ -89,14 +96,18 @@ semPlotModel.mplus.model <- function (object,mplusStd=c("std", "stdy", "stdxy"), est = parsUS$est, std = NA, group = parsUS$Group, - fixed = parsUS$se==0, + fixed = fixed, par = 0, BetweenWithin = parsUS$BetweenWithin, stringsAsFactors=FALSE) + # This code will check if parameters are equal. Check on as many of these columns as possible: + checkCols <- c("est","se", "posterior_sd" ,"pval","lower_2.5ci","upper_2.5ci" ) + checkCols <- checkCols[checkCols %in% names(parsUS)] + if (!noPars) { - parNums <- dlply(cbind(sapply(parsUS[c("est","se")],function(x)round(as.numeric(x),10)),data.frame(num=1:nrow(parsUS))),c("est","se"),'[[',"num") + parNums <- dlply(cbind(sapply(parsUS[checkCols],function(x)round(as.numeric(x),10)),data.frame(num=1:nrow(parsUS))),checkCols,'[[',"num") for (i in 1:length(parNums)) Pars$par[parNums[[i]]] <- i Pars$par[Pars$fixed] <- 0 } else Pars$par <- 1:nrow(Pars) @@ -128,18 +139,22 @@ semPlotModel.mplus.model <- function (object,mplusStd=c("std", "stdy", "stdxy"), # Pars$std <- object$parameters$stdyx.standardized$est # } + if (!is.null(object$parameters$std.standardized) && mplusStd == "std") { Pars$std <- object$parameters$std.standardized$est # warning("Mplus std parameters will be plotted. To change that, use the modelOpts argument and set mplusStd to stdy, or stdyx parameters.") - }else if (!is.null(object$parameters$stdy.standardized) && mplusStd == "std"){ + } else if (!is.null(object$parameters$stdy.standardized) && mplusStd == "stdy") + { Pars$std <- object$parameters$stdy.standardized$est - }else if (!is.null(object$parameters$stdyx.standardized) && mplusStd == "std"){ + } else if (!is.null(object$parameters$stdyx.standardized) && mplusStd == "stdyx") + { Pars$std <- object$parameters$stdyx.standardized$est + } else if (!is.null(object$parameters$standardized)) + { + Pars$std <- object$parameters$standardized$est } - - Pars$lhs[grepl(".BY$",parsUS$paramHeader)] <- gsub("\\.BY$","",parsUS$paramHeader[grepl(".BY$",parsUS$paramHeader)]) Pars$edge[grepl(".BY$",parsUS$paramHeader)] <- "->" @@ -153,10 +168,7 @@ semPlotModel.mplus.model <- function (object,mplusStd=c("std", "stdy", "stdxy"), Pars$lhs[grepl("Variances",parsUS$paramHeader)] <- Pars$rhs[grepl("Variances",parsUS$paramHeader)] Pars$edge[grepl("Variances",parsUS$paramHeader)] <- "<->" - Pars$edge[grepl("Means|Intercepts",parsUS$paramHeader)] <- "int" - - if (!is.null(object$parameters$standardized)) Pars$std <- object$parameters$standardized$est - + Pars$edge[grepl("Means|Intercepts",parsUS$paramHeader)] <- "int" # Extract threshold model: Thresh <- Pars[grepl("Thresholds",parsUS$paramHeader),-(3:4)] @@ -227,4 +239,4 @@ semPlotModel.mplus.model <- function (object,mplusStd=c("std", "stdy", "stdxy"), semModel@ImpCovs <- ImpCovs return(semModel) -} \ No newline at end of file +} diff --git a/R/regsemplot.R b/R/regsemplot.R new file mode 100644 index 0000000..bddbf9c --- /dev/null +++ b/R/regsemplot.R @@ -0,0 +1,86 @@ + + +semPlotModel.regsem <- semPlotModel.regsemplot <- function(object,...){ + + ## Save parts of the output in objects + object1 <- object$lav.model@ParTable # parameters + object2 <- object$lav.model@Model@dimNames # variable names + varnames <- unique(c(object1$lhs, object1$rhs)) # all names + mannames <- object2[[1]][1] # manifest variables + names(mannames) <- 'manifest' + + '%!in%' <- function(x,y)!('%in%'(x,y)) + + ## Add the fixed relations to the parameter estimates of regsem + namelist <- strsplit(names(object$out$pars)," ") # split names and operators + inout <- data.frame(1,2) + for(i in 1:length(namelist)){ + inout[i,1] <- namelist[[i]][1] + inout[i,2] <- namelist[[i]][3] + } # create data frame of regsem variables + + int <- data.frame(1,2) + for(i in 1:length(object1$lhs)){ + int[i,1] <- ifelse(object1$op[i]=="~"|object1$op[i]=="~1",object1$rhs[i],object1$lhs[i]) + int[i,2] <- ifelse(object1$op[i]=="~"|object1$op[i]=="~1",object1$lhs[i],object1$rhs[i]) + } # create data frame of lavaan variables + + ## Paste together + pinout <- with(inout, paste0(X1, X2)) + pint <- with(int, paste0(X1, X2)) + counter <- 0 + + for(i in 1:length(pint)){ + if(pint[i] %!in% pinout){ + object1$regest[i] <- 1 + counter <- counter + 1 + } else { + object1$regest[i] <- object$out$pars[i - counter] + } + } # match regsem estimates with lavaan variables, set fixed to 1 + + + ## Create a S4 list + semModel <- new("semPlotModel") + + ## Create a Pars data frame + semModel@Pars <- data.frame( + label = rep("", length(object1$id)), + lhs = ifelse(object1$op=="~"|object1$op=="~1",object1$rhs,object1$lhs), # first went from left to right without checking relationship + edge = "--", + rhs = ifelse(object1$op=="~"|object1$op=="~1",object1$lhs,object1$rhs), + est = object1$regest, # check if we should take estimates from other model, if estimates are same as in regsem + std = NA, + group = object1$group, + fixed = object1$free == 0, + par = object1$free, + stringsAsFactors=FALSE) + row.names(semModel@Pars) <- 1:length(object1$id) + + ## translate operators + semModel@Pars$edge[object1$op=="~~"] <- "<->" + semModel@Pars$edge[object1$op=="~*~"] <- "<->" + semModel@Pars$edge[object1$op=="~"] <- "~>" + semModel@Pars$edge[object1$op=="=~"] <- "->" + semModel@Pars$edge[object1$op=="~1"] <- "int" + semModel@Pars$edge[grepl("\\|",object1$op)] <- "|" + + semModel@Pars <- semModel@Pars[!object$op%in%c(':=','<','>','==','|','<', '>'),] + + ## Create a vars data frame + semModel@Vars <- data.frame( + name = varnames, + manifest = varnames[1:length(varnames)] %in% mannames$manifest[1:length(mannames$manifest)], + exogenous = NA, + stringsAsFactors = FALSE + ) + + ## Miscellaneous data frames + semModel@Thresholds <- data.frame() + semModel@ObsCovs <- list() + semModel@ImpCovs <- list() + semModel@Computed <- FALSE + semModel@Original <- list(object) + + return(semModel) +} diff --git a/R/semPaths.R b/R/semPaths.R index 040ecd1..1f6d287 100644 --- a/R/semPaths.R +++ b/R/semPaths.R @@ -353,6 +353,7 @@ semPaths <- function(object,what="paths",whatLabels,style,layout="tree",intercep par(ask=ask) ### If no sub, set sub to 0 (root sub) + if (is.null(object@Pars$sub)) { if (!layoutSplit) @@ -884,7 +885,6 @@ semPaths <- function(object,what="paths",whatLabels,style,layout="tree",intercep if (length(levels) +Jason Nak +Myrthe Veenman +} + +\seealso{ +\code{\link{semPlotModel}} + \code{\link{semPaths}} +} +\examples{ +## Example of fitting and plotting a cv_regsem model in semPaths + +#library(psych) +#library(lavaan) +#library(regsem) + +# use a subset of the BFI +#bfi2 <- bfi[1:250,c(1:5,18,22)] +#bfi2[,1] <- reverse.code(-1,bfi2[,1]) + +# specify a SEM model +#mod <- " +#f1 =~ NA*A1+A2+A3+A4+A5+O2+N3 +#f1~~1*f1 +#" + +# fit the model +#fit <- cfa(mod, bfi2) +#out.reg <- cv_regsem(fit, type="lasso", pars_pen=c(1:7), n.lambda=23, jump =.05) + +# plot the model +#semPaths(semPlotModel.cvregsemplot(object = out.reg, model = fit)) +} + diff --git a/man/modelMatrices.Rd b/man/modelMatrices.Rd index ba20e41..9170656 100644 --- a/man/modelMatrices.Rd +++ b/man/modelMatrices.Rd @@ -60,7 +60,4 @@ semPaths(do.call(ramModel, RAM), as.expression = "edges", intercepts = FALSE) LISREL <- modelMatrices(outfile, "lisrel") semPaths(do.call(lisrelModel, LISREL), as.expression = "edges", intercepts = FALSE) } -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{ ~kwd1 } -\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line + diff --git a/man/regsemplot.Rd b/man/regsemplot.Rd new file mode 100644 index 0000000..5666368 --- /dev/null +++ b/man/regsemplot.Rd @@ -0,0 +1,62 @@ +\name{regsem} +\alias{semPlotModel.regsem} +\title{ +Bridge between regsem output and sempaths +} +\description{ + The package regsem (Jacobucci, 2017) is designed for a specific type of SEM called regularized structural equation modelling (RegSEM). For more information about RegSEM and the implementation in R we refer to the manual written by Jacobucci (2017).This function creates a bridge between the regsem and semplot packages, making it possible to use output from the regsem() and cv_regsem() functions to create models in sempaths. +} +\usage{ +\method{semPlotModel}{regsem}(object,\dots) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{object}{ + The regsem output +} +\item{\dots}{Arguments sent to 'lisrelModel', not used in other methods.} +} + + +\value{ +A 'semPlotModel' object. +} +\references{ +Jacobucci, R. (2017). regsem: Regularized Structural Equation Modeling. arXiv preprint arXiv:1703.08489. +} +\author{ +Sacha Epskamp +Myrthe Veenman +Jason Nak +} + +\seealso{ +\code{\link{semPlotModel}} + \code{\link{semPaths}} +} + +\examples{ + +## Example of fitting and plotting a regsem model in semPaths +# library(psych) +#library(lavaan) +#library(regsem) + +# use a subset of the BFI +#bfi2 <- bfi[1:250,c(1:5,18,22)] +#bfi2[,1] <- reverse.code(-1,bfi2[,1]) + +# specify a SEM model +#mod <- " +#f1 =~ NA*A1+A2+A3+A4+A5+O2+N3 +#f1~~1*f1 +#" + +# fit the model +#fit <- cfa(mod, bfi2) +#out.reg <- regsem(fit, type="lasso", pars_pen=c(1:7)) + +# plot the model +#semPaths(semPlotModel.regsemplot(object = out.reg)) + +} \ No newline at end of file diff --git a/man/semPlotModel.Rd b/man/semPlotModel.Rd index e75e21e..cf99487 100644 --- a/man/semPlotModel.Rd +++ b/man/semPlotModel.Rd @@ -32,7 +32,7 @@ Methods to read a SEM object and return a \code{\link{semPlotModel-class}} objec % \method{semPlotModel}{lavaan}(object) \method{semPlotModel}{lisrel}(object, \dots) % \method{semPlotModel}{semspec}(object) -\method{semPlotModel}{mplus.model}(object, mplusStd = c("std", "stdy", "stdxy"), \dots) +\method{semPlotModel}{mplus.model}(object, mplusStd = c("std", "stdy", "stdyx"), \dots) \method{semPlotModel}{sem}(object, \dots) \method{semPlotModel}{msem}(object, \dots) \method{semPlotModel}{msemObjectiveML}(object, \dots) @@ -48,6 +48,9 @@ An object contaning the result of a SEM or GLM analysis, or a string contaning t \item{mplusStd}{ What standardization to use in Mplus models? } +\item{model}{ +The original sem model (used in cvregsem) +} \item{\dots}{Arguments sent to 'lisrelModel', not used in other methods.} } \details{