diff --git a/DESCRIPTION b/DESCRIPTION index 30cb6e2b..7a67b54c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: lavaan Title: Latent Variable Analysis -Version: 0.6-20.2259 +Version: 0.6-20.2260 Authors@R: c(person(given = "Yves", family = "Rosseel", role = c("aut", "cre"), email = "Yves.Rosseel@UGent.be", @@ -61,7 +61,6 @@ Description: Fit a variety of latent variable models, including confirmatory Depends: R(>= 3.4) Imports: methods, stats4, stats, utils, graphics, MASS, mnormt, pbivnorm, numDeriv, quadprog -Suggests: lavaanC BugReports: https://github.com/yrosseel/lavaan/issues License: GPL (>= 2) LazyData: yes diff --git a/R/lav_lavaan_step09_model.R b/R/lav_lavaan_step09_model.R index 5f5a8dbf..a9cb5b88 100644 --- a/R/lav_lavaan_step09_model.R +++ b/R/lav_lavaan_step09_model.R @@ -74,6 +74,16 @@ lav_lavaan_step09_model <- function(slotModel = NULL, # nolint } } } + + # same for composites: call lav_model_set_parameters once to set + # total/residual variances of composites in PSI + } else if (lavmodel@composites) { + lavmodel <- lav_model_set_parameters( + lavmodel = lavmodel, + x = lav_model_get_parameters(lavmodel) + ) + # re-adjust parameter table + lavpartable$start <- lav_model_get_parameters(lavmodel, type = "user") } if (lav_verbose()) { cat(" done.\n") diff --git a/R/lav_lavaan_step11_optim.R b/R/lav_lavaan_step11_optim.R index 8ec856f9..a51c083e 100644 --- a/R/lav_lavaan_step11_optim.R +++ b/R/lav_lavaan_step11_optim.R @@ -280,7 +280,7 @@ lav_lavaan_step11_estoptim <- function(lavdata = NULL, # nolint # if a warning was produced, say it here warn.txt <- attr(x, "warn.txt") - if (nchar(warn.txt) > 0L) { + if (!is.null(warn.txt) && nchar(warn.txt) > 0L) { lav_msg_warn( gettext("Model estimation FAILED! Returning starting values.")) } diff --git a/R/lav_model.R b/R/lav_model.R index f13ae888..48551e68 100644 --- a/R/lav_model.R +++ b/R/lav_model.R @@ -356,6 +356,13 @@ lav_model <- function(lavpartable = NULL, # nolint names(ov.efa.idx[[g]]) <- efa.values names(lv.efa.idx[[g]]) <- efa.values } # efa + + # set variances composites (new in 0.6-20) + if (composites) { + mm.in.group <- 1:nmat[g] + cumsum(c(0L, nmat))[g] + tmp.glist[mm.in.group] <- + setVarianceComposites.LISREL(tmp.glist[mm.in.group]) + } } # g # fixed.x parameters? diff --git a/R/lav_model_estimate.R b/R/lav_model_estimate.R index 2416c3f6..0b4b4717 100644 --- a/R/lav_model_estimate.R +++ b/R/lav_model_estimate.R @@ -503,7 +503,7 @@ lav_model_estimate <- function(lavmodel = NULL, attr(fx, "fx.group") <- rep(as.numeric(NA), ngroups) attr(x, "converged") <- FALSE attr(x, "iterations") <- 0L - attr(x, "control") <- lavoptions@control + attr(x, "control") <- lavoptions$control attr(x, "fx") <- fx return(x) } diff --git a/R/lav_partable_flat.R b/R/lav_partable_flat.R index 4b32807c..3ea7f8d1 100644 --- a/R/lav_partable_flat.R +++ b/R/lav_partable_flat.R @@ -38,7 +38,7 @@ lav_partable_flat <- function(FLAT = NULL, # nolint lv.names <- lav_partable_vnames(FLAT, type = "lv") # latent variables # lv.names.r <- lav_partable_vnames(FLAT, type="lv.regular") # regular latent variables - if (composites ) { + if (composites) { lv.names.f <- character(0L) lv.names.c <- lav_partable_vnames(FLAT, type = "lv.composite") ov.ind.c <- lav_partable_vnames(FLAT, type = "ov.cind") @@ -222,8 +222,8 @@ lav_partable_flat <- function(FLAT = NULL, # nolint # auto-remove ordinal variables # idx <- match(ov.names.ord, ov.var) # if(length(idx)) ov.var <- ov.var[-idx] - lhs <- c(lhs, ov.var, lv.names.noc) - rhs <- c(rhs, ov.var, lv.names.noc) + lhs <- c(lhs, ov.var, lv.names) + rhs <- c(rhs, ov.var, lv.names) # } # b) `independent` latent variable COVARIANCES (lv.names.x) @@ -480,6 +480,15 @@ lav_partable_flat <- function(FLAT = NULL, # nolint free[var.idx] <- 0L } + # 0d. variances for composites: ALWAYS fixed (should be set later + # by setVarianceComposites.LISREL + if (length(lv.names.c) > 0) { + var.idx <- which(op == "~~" & lhs %in% lv.names.c & lhs == rhs) + ustart[var.idx] <- as.numeric(NA) + free[var.idx] <- 0L + } + + # 1. fix metric of regular latent variables if (std.lv) { # fix metric by fixing the variance of the latent variable diff --git a/R/lav_partable_utils.R b/R/lav_partable_utils.R index f3ab72ef..51f1ef57 100644 --- a/R/lav_partable_utils.R +++ b/R/lav_partable_utils.R @@ -107,6 +107,7 @@ lav_partable_ndat <- function(partable) { fixed.x <- any(partable$exo > 0L & partable$free == 0L) conditional.x <- any(partable$exo > 0L & partable$op == "~") categorical <- any(partable$op == "|") + composites <- any(partable$op == "<~") correlation <- any(partable$op == "~*~") if (categorical) { meanstructure <- TRUE @@ -176,6 +177,16 @@ lav_partable_ndat <- function(partable) { ndat[b] <- ndat[b] - pstar.x } + # composites? + if (composites) { + ov.cind <- lav_partable_vnames(partable, "ov.cind", block = b) + covar.idx <- which(partable$op == "~~" & + partable$lhs %in% ov.cind & + partable$rhs %in% ov.cind & + partable$free == 0L) + ndat[b] <- ndat[b] - length(covar.idx) + } + # correction for ordinal data? if (categorical) { ov.names.x <- lav_partable_vnames(partable, "ov.x", block = b) diff --git a/R/lav_simulate_old.R b/R/lav_simulate_old.R index b0f6f868..8bc02e93 100644 --- a/R/lav_simulate_old.R +++ b/R/lav_simulate_old.R @@ -14,6 +14,7 @@ simulateData <- function( # user-specified model int.lv.free = FALSE, marker.int.zero = FALSE, conditional.x = FALSE, + composites = TRUE, fixed.x = FALSE, orthogonal = FALSE, std.lv = TRUE, @@ -72,6 +73,7 @@ simulateData <- function( # user-specified model int.ov.free = int.ov.free, int.lv.free = int.lv.free, marker.int.zero = marker.int.zero, + composites = composites, conditional.x = conditional.x, fixed.x = fixed.x, orthogonal = orthogonal, @@ -154,11 +156,13 @@ simulateData <- function( # user-specified model "if residual variances are specified, please use standardized=FALSE")) } - # new in 0.6-20: use setResidualElements.LISREL + # new in 0.6-20: - use setResidualElements.LISREL + # - use setVarianceComposites.LISREL dotdotdot <- list(...) dotdotdot$sample.nobs <- sample.nobs dotdotdot$fixed.x <- FALSE # for now dotdotdot$representation <- "LISREL" + dotdotdot$composites <- composites dotdotdot$correlation <- TRUE # this is the trick tmp.fit <- do.call("lavaan", args = c(list(model = lav), dotdotdot)) # set/get parameters to invoke setResidualElements.LISREL diff --git a/R/lav_start.R b/R/lav_start.R index 7a1da057..e1a6aa82 100644 --- a/R/lav_start.R +++ b/R/lav_start.R @@ -68,6 +68,7 @@ lav_start <- function(start.method = "default", start <- numeric(length(lavpartable$ustart)) # if(categorical || correlation) { start[which(lavpartable$op == "=~")] <- 0.7 + start[which(lavpartable$op == "<~")] <- 1 # } else { # start[ which(lavpartable$op == "=~") ] <- 1.0 # } @@ -182,6 +183,7 @@ lav_start <- function(start.method = "default", lv.names.efa <- vnames(lavpartable, "lv.efa", group = group.values[g]) ov.names.x <- vnames(lavpartable, "ov.x", group = group.values[g]) ov.ind.c <- vnames(lavpartable, "ov.cind", group = group.values[g]) + lv.names.c <- vnames(lavpartable, "lv.composite", group = group.values[g]) # just for the nlevels >1 case ov.names <- unique(unlist(ov.names)) @@ -190,7 +192,8 @@ lav_start <- function(start.method = "default", lv.names.efa <- unique(unlist(lv.names.efa)) ov.names.x <- unique(unlist(ov.names.x)) ov.ind.c <- unique(unlist(ov.ind.c)) - + lv.names.c <- unique(unlist(lv.names.c)) + lv.names.noc <- lv.names[!lv.names %in% lv.names.c] # residual ov variances (including exo/ind, to be overriden) ov.var.idx <- which(lavpartable$group == group.values[g] & @@ -235,7 +238,7 @@ lav_start <- function(start.method = "default", if (start.initial %in% c("lavaan", "mplus") && model.type %in% c("sem", "cfa")) { # fabin3 estimator (2sls) of Hagglund (1982) per factor - for (f in lv.names) { + for (f in lv.names.noc) { # not for efa factors if (f %in% lv.names.efa) { next