Skip to content

Commit 9794e31

Browse files
yrosseelyrosseel
committed
[IV estimation] allow for ordered = TRUE (but not conditional.x = TRUE)
1 parent f42c691 commit 9794e31

File tree

9 files changed

+319
-194
lines changed

9 files changed

+319
-194
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: lavaan
22
Title: Latent Variable Analysis
3-
Version: 0.6-22.2506
3+
Version: 0.6-22.2513
44
Authors@R: c(person(given = "Yves", family = "Rosseel",
55
role = c("aut", "cre"),
66
email = "Yves.Rosseel@UGent.be",

‎R/lav_model_utils.R‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -88,10 +88,14 @@ lav_model_set_parameters <- function(lavmodel = NULL, x = NULL) {
8888
# which mm belong to group g?
8989
mm.in.group <- 1:nmat[g] + cumsum(c(0L, nmat))[g]
9090

91-
if (lavmodel@estimator %in% c(
92-
"ML", "WLS", "GLS", "DWLS", "ULS", "PML",
93-
"catML"
94-
)) {
91+
if (lavmodel@estimator %in% c("MML", "FML")) {
92+
# ttt <- diag(tmp[mm.in.group]$theta)
93+
# diag(tmp[mm.in.group]$theta) <- as.numeric(NA)
94+
# if(length(lavmodel@num.idx[[g]]) > 0L) {
95+
# diag(tmp[mm.in.group]$theta)[ lavmodel@num.idx[[g]] ] <-
96+
# ttt[ lavmodel@num.idx[[g]] ]
97+
# }
98+
} else {
9599
if (lavmodel@parameterization == "delta") {
96100
tmp[mm.in.group] <-
97101
lav_lisrel_residual_variances(
@@ -107,13 +111,6 @@ lav_model_set_parameters <- function(lavmodel = NULL, x = NULL) {
107111
num.idx = lavmodel@num.idx[[g]]
108112
)
109113
}
110-
} else if (lavmodel@estimator %in% c("MML", "FML")) {
111-
# ttt <- diag(tmp[mm.in.group]$theta)
112-
# diag(tmp[mm.in.group]$theta) <- as.numeric(NA)
113-
# if(length(lavmodel@num.idx[[g]]) > 0L) {
114-
# diag(tmp[mm.in.group]$theta)[ lavmodel@num.idx[[g]] ] <-
115-
# ttt[ lavmodel@num.idx[[g]] ]
116-
# }
117114
}
118115
}
119116
} else {
@@ -122,8 +119,8 @@ lav_model_set_parameters <- function(lavmodel = NULL, x = NULL) {
122119
}
123120

124121
if (lavmodel@composites) {
125-
# for package stdmod only! (vignette stdmod_lavaan uses old fit object)
126-
#if (.hasSlot(lavmodel, "composites") && lavmodel@composites) {
122+
# for package stdmod only! (vignette stdmod_lavaan uses old fit object)
123+
# if (.hasSlot(lavmodel, "composites") && lavmodel@composites) {
127124
nmat <- lavmodel@nmat
128125
if (lavmodel@representation == "LISREL") {
129126
for (g in 1:lavmodel@nblocks) {
@@ -267,9 +264,12 @@ lav_model_dmmdpar <- function(lavmodel, target = "theta", group = 1L) {
267264
# find target model matrix
268265
mlist.idx <- which(names(MLIST) == target)
269266
if (length(mlist.idx) == 0L) {
270-
lav_msg_stop(gettextf(
271-
"model matrix \"%s\" not found. Available model matrices are:", target),
272-
paste(names(MLIST), collapse = " "))
267+
lav_msg_stop(
268+
gettextf(
269+
"model matrix \"%s\" not found. Available model matrices are:", target
270+
),
271+
paste(names(MLIST), collapse = " ")
272+
)
273273
}
274274

275275
# target idx in GLIST

‎R/lav_object_inspect.R‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3335,13 +3335,13 @@ lav_object_inspect_ntotal <- function(object) {
33353335
}
33363336

33373337
lav_object_inspect_iv <- function(object, drop.list.single.group = FALSE) {
3338-
3338+
33393339
if (is.null(object@internal$eqs)) {
33403340
lav_msg_stop(gettext("no equations/ivs found"))
33413341
}
33423342
lavmodel <- object@Model
33433343
lavdata <- object@Data
3344-
3344+
33453345
# grab equations
33463346
iv_list <- object@internal$eqs
33473347

@@ -3379,13 +3379,13 @@ lav_object_inspect_iv <- function(object, drop.list.single.group = FALSE) {
33793379
}
33803380

33813381
lav_object_inspect_eqs <- function(object, drop.list.single.group = FALSE) {
3382-
3382+
33833383
if (is.null(object@internal$eqs)) {
33843384
lav_msg_stop(gettext("no equations/ivs found"))
3385-
}
3385+
}
33863386
lavmodel <- object@Model
33873387
lavdata <- object@Data
3388-
3388+
33893389
# grab equations
33903390
eqs <- object@internal$eqs
33913391

@@ -3431,7 +3431,7 @@ lav_object_inspect_sargan <- function(object, drop.list.single.group = FALSE) {
34313431
sargan.pvalue <- sapply(seq_along(eqs),
34323432
function(x) eqs[[x]][["sargan"]]["pvalue"])
34333433
table[[b]] <- data.frame(
3434-
lhs = lhs, rhs = rhs, instruments = miiv,
3434+
lhs = lhs, rhs = rhs, instruments = miiv,
34353435
sargan.stat = sargan.stat, df = sargan.df, pvalue = sargan.pvalue
34363436
)
34373437

‎R/lav_options_estimator.R‎

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -586,14 +586,21 @@ lav_options_est_iv <- function(opt) {
586586
opt$bounds <- "standard"
587587
}
588588
# test
589-
if (opt$test == "default") {
590-
opt$test <- "browne.residual.nt" # sample-based (especially for baseline)
589+
if (length(opt$test) == 1L && opt$test == "default") {
590+
if (opt$.categorical) {
591+
opt$test <- "browne.residual.adf" # always sample-based
592+
} else {
593+
opt$test <- "browne.residual.nt" # sample-based (especially for baseline)
594+
}
591595
}
592-
opt$standard.test <- opt$test
596+
opt$standard.test <- opt$test[1]
593597

594598
# missing
595599
opt$missing <- "listwise" # for now
596600

601+
# sample.icov not needed
602+
opt$sample.icov <- FALSE
603+
597604
# estimator options
598605
if (is.null(opt$estimator.args)) {
599606
# create default list

‎R/lav_partable.R‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1066,20 +1066,20 @@ lav_model_partable <- function(
10661066
block = b
10671067
)
10681068
lv.marker <- lav_partable_vnames(tmp.list,
1069-
type = "lv.regular",
1069+
type = "lv.marker",
10701070
block = b
10711071
)
1072+
ov.num <- lav_partable_vnames(tmp.list,
1073+
type = "ov.num",
1074+
block = b
1075+
)
1076+
# new in 0.6-22: only consider ov.num markers
1077+
lv.marker <- lv.marker[lv.marker %in% ov.num]
10721078

1073-
if (length(lv.names) == 0L) {
1079+
if (length(lv.marker) == 0L) {
10741080
next
10751081
}
10761082

1077-
# markers for this block
1078-
lv.marker <- lav_partable_vnames(tmp.list,
1079-
type = "lv.marker",
1080-
block = b
1081-
)
1082-
10831083
# fix marker intercepts to zero
10841084
marker.idx <- which(tmp.list$op == "~1" &
10851085
tmp.list$lhs %in% lv.marker & tmp.list$block == b &

‎R/lav_samplestats.R‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -827,7 +827,7 @@ lav_samplestats_from_data <- function(lavdata = NULL,
827827
Mplus.WLS = FALSE
828828
)
829829
}
830-
} else if (estimator %in% c("WLS", "DWLS", "ULS", "DLS", "catML")) {
830+
} else if (estimator %in% c("WLS", "DWLS", "ULS", "DLS", "catML", "IV")) {
831831
if (!categorical) {
832832
# sample size large enough?
833833
nvar <- ncol(X[[g]])
@@ -839,7 +839,7 @@ lav_samplestats_from_data <- function(lavdata = NULL,
839839
if (conditional.x && nexo > 0L) {
840840
pstar <- pstar + (nvar * nexo)
841841
}
842-
if (nrow(X[[g]]) < pstar) {
842+
if (nrow(X[[g]]) < pstar && estimator != "IV") {
843843
if (ngroups > 1L) {
844844
lav_msg_warn(gettextf(
845845
"number of observations (%s) too small to compute Gamma",
@@ -867,7 +867,7 @@ lav_samplestats_from_data <- function(lavdata = NULL,
867867
meanstructure = meanstructure
868868
)
869869
} else {
870-
if (lavoptions$se == "robust.sem.nt") {
870+
if (lavoptions$se == "robust.sem.nt" || estimator == "IV") {
871871
NACOV[[g]] <-
872872
lav_samplestats_Gamma_NT(
873873
Y = Y,
@@ -996,7 +996,7 @@ lav_samplestats_from_data <- function(lavdata = NULL,
996996
}
997997
} else if (estimator == "ML") {
998998
# no WLS.V here, since function of model-implied moments
999-
} else if (estimator %in% c("WLS", "DWLS", "ULS", "DLS")) {
999+
} else if (estimator %in% c("WLS", "DWLS", "ULS", "DLS", "IV")) {
10001000
if (!categorical) {
10011001
if (estimator == "WLS" || estimator == "DLS") {
10021002
if (!fixed.x) {
@@ -1078,7 +1078,7 @@ lav_samplestats_from_data <- function(lavdata = NULL,
10781078
# WLS.V[[g]] <- diag(1/dacov, nrow=NROW(CAT$WLS.W),
10791079
# ncol=NCOL(CAT$WLS.W))
10801080
WLS.VD[[g]] <- 1 / dacov
1081-
} else if (estimator == "ULS") {
1081+
} else if (estimator == "ULS" || estimator == "IV") {
10821082
# WLS.V[[g]] <- diag(length(WLS.obs[[g]]))
10831083
WLS.VD[[g]] <- rep(1, length(WLS.obs[[g]]))
10841084
}

0 commit comments

Comments
 (0)