Skip to content

Commit 9fb7230

Browse files
juliuspfadtjuliuspfadt
committed
change model fit table, and remove multi models
1 parent 5d03c87 commit 9fb7230

File tree

3 files changed

+114
-300
lines changed

3 files changed

+114
-300
lines changed

‎R/plssem.R

Lines changed: 69 additions & 229 deletions
Original file line numberDiff line numberDiff line change
@@ -263,9 +263,7 @@ checkCSemModel <- function(model, availableVars) {
263263
# store results in model container
264264
if (!modelContainer$getError()) {
265265
modelContainer[["results"]] <- createJaspState(results)
266-
modelContainer[["results"]]$dependOn(optionsFromObject = modelContainer)
267266
modelContainer[["models"]] <- createJaspState(options[["models"]])
268-
modelContainer[["models"]]$dependOn(optionsFromObject = modelContainer)
269267
}
270268

271269
return(results)
@@ -312,32 +310,17 @@ checkCSemModel <- function(model, availableVars) {
312310
# create model fit table
313311
if (!is.null(modelContainer[["fittab"]])) return()
314312

315-
316-
fittab <- createJaspTable(title = gettext("Model fit"))
317-
fittab$dependOn(c("models"))
313+
fittab <- createJaspTable(title = gettext("Model Fit"))
314+
fittab$dependOn(optionsFromObject = modelContainer,
315+
options = c("group", "bollenStineBootstrapSamples", "significanceLevel", "saturatedStructuralModel"))
318316
fittab$position <- 0
319317

320-
# fittab$addColumnInfo(name = "Model", title = "", type = "string", combine = TRUE)
321318
if (options[["group"]] != "")
322-
fittab$addColumnInfo(name = "group", title = gettext("Group"), type = "string" )
323-
fittab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" )
324-
fittab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" )
325-
fittab$addColumnInfo(name = "N", title = gettext("n"), type = "integer")
326-
fittab$addColumnInfo(name = "Chisq", title = "\u03C7\u00B2", type = "number" ,
327-
overtitle = gettext("Baseline test"))
328-
fittab$addColumnInfo(name = "Df", title = gettext("df"), type = "integer",
329-
overtitle = gettext("Baseline test"))
330-
fittab$addColumnInfo(name = "PrChisq", title = gettext("p"), type = "pvalue",
331-
overtitle = gettext("Baseline test"))
332-
if (length(options[["models"]]) > 1) {
333-
fittab$addColumnInfo(name = "dchisq", title = "\u0394\u03C7\u00B2", type = "number" ,
334-
overtitle = gettext("Difference test"))
335-
fittab$addColumnInfo(name = "ddf", title = "\u0394df", type = "integer",
336-
overtitle = gettext("Difference test"))
337-
fittab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" ,
338-
overtitle = gettext("Difference test"))
339-
}
319+
fittab$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE)
340320

321+
fittab$addColumnInfo(name = "measure", title = gettext("Distance Measure"), type = "string" )
322+
fittab$addColumnInfo(name = "statistic", title = gettext("Test Statistic"), type = "number" )
323+
fittab$addColumnInfo(name = "critValue", title = gettext("Critical Value"), type = "number" )
341324

342325
modelContainer[["fittab"]] <- fittab
343326

@@ -348,152 +331,42 @@ checkCSemModel <- function(model, availableVars) {
348331

349332
if (modelContainer$getError()) return()
350333

334+
# we need this for a lot of other tables
335+
results <- plsSemResults[[1]]
336+
msc <- .withWarnings(.computeMSC(results, dataset, options))
337+
#create jasp state and store msc for additional output tables
338+
modSelCriteria <- createJaspState()
339+
modelContainer[["modSelCriteria"]] <- modSelCriteria
340+
modSelCriteria$dependOn(optionsFromObject = modelContainer)
341+
modSelCriteria$object <- msc
351342

352-
if (length(plsSemResults) < 2) {
353-
if (options[["group"]] == "") {
354-
355-
msc <- .withWarnings(.computeMSC(plsSemResults[[1]], dataset, options))
356-
357-
name <- options[["models"]][[1]][["name"]]
358-
aic <- msc$value$msc$AIC
359-
bic <- msc$value$msc$BIC
360-
Ns <- nrow(dataset)
361-
chisq <- msc$value$mfm$Chi_square
362-
df <- msc$value$mfm$Df
363-
prChisq <- pchisq(q = chisq, df = df, lower.tail = FALSE)
364-
365-
} else {
366-
367-
msc <- .withWarnings(.computeMSC(plsSemResults[[1]], dataset, options))
368-
369-
name <- rep(options[["models"]][[1]][["name"]], length(plsSemResults[[1]]))
370-
group <- names(plsSemResults[[1]])
371-
aic <- msc$value$msc["AIC",]
372-
bic <- msc$value$msc["BIC",]
373-
Ns <- msc$value$Ns
374-
chisq <- msc$value$mfm["Chi_square",]
375-
df <- msc$value$mfm["Df",]
376-
prChisq <- prChisq <- mapply(pchisq, q = chisq, df = df, lower.tail = FALSE)
377-
378-
}
379-
} else {
380-
postEstimation_args <- plsSemResults
381-
names(postEstimation_args) <- "object" # (the first result is object, the others ...)
382-
name <- list()
383-
aic <- list()
384-
bic <- list()
385-
Ns <- list()
386-
chisq <- list()
387-
df <- list()
388-
prChisq <- list()
389-
group <- list()
390-
rsquared <- list()
391-
392-
if (options[["group"]] == "") {
393-
394-
msc <- .withWarnings(lapply(postEstimation_args, .computeMSC, dataset = dataset, options = options))
395-
396-
name <- vapply(options[["models"]], getElement, name = "name", "")
397-
Ns <- rep(nrow(dataset), length(plsSemResults))
398-
for (i in seq_along(options[["models"]])) {
399-
400-
aic <- c(aic, msc$value[[i]]$msc$AIC)
401-
bic <- c(bic, msc$value[[i]]$msc$BIC)
402-
chisq <- c(chisq, msc$value[[i]]$mfm$Chi_square)
403-
df <- c(df, msc$value[[i]]$mfm$Df)
404-
prChisq <- c(prChisq, pchisq(q = msc$value[[i]]$mfm$Chi_square, df = msc$value[[i]]$mfm$Df, lower.tail = FALSE))
405-
}
406-
407-
} else {
408-
409-
msc <- .withWarnings(lapply(postEstimation_args, .computeMSC, dataset = dataset, options = options))
410-
for (i in seq_along(options[["models"]])) {
411-
412-
name <- c(name, rep(options[["models"]][[i]][["name"]], length(plsSemResults[[i]])))
413-
aic <- c(aic, msc$value[[i]]$msc["AIC",])
414-
bic <- c(bic, msc$value[[i]]$msc["BIC",])
415-
Ns <- c(Ns, msc$value[[i]]$Ns)
416-
chisq <- c(chisq, msc$value[[i]]$mfm["Chi_square",])
417-
df <- c(df, msc$value[[i]]$mfm["Df",])
418-
prChisq <- c(prChisq, mapply(pchisq, q = msc$value[[i]]$mfm["Chi_square",], df = msc$value[[i]]$mfm["Df",], lower.tail = FALSE))
419-
group <- c(group, names(plsSemResults[[i]]))
420-
}
421-
}
422-
}
423-
424-
# fittab[["Model"]] <- name
425-
if (options[["group"]] != "")
426-
fittab[["group"]] <- group
427-
fittab[["AIC"]] <- aic
428-
fittab[["BIC"]] <- bic
429-
fittab[["N"]] <- Ns
430-
fittab[["Chisq"]] <- chisq
431-
fittab[["Df"]] <- df
432-
fittab[["PrChisq"]] <- prChisq
433-
434-
if (length(options[["models"]]) > 1) {
435-
groupLength <- length(chisq) / length(options[["models"]])
436-
dchisq <- as.list(rep(NA, groupLength))
437-
ddf <- as.list(rep(NA, groupLength))
438-
dPrChisq <- as.list(rep(NA, groupLength))
439-
chisq <- as.list(chisq)
440-
df <- as.list(df)
441-
for(i in 1:(length(chisq)-groupLength)) {
442-
dchisq <- c(dchisq, abs(unlist(chisq[i+groupLength])- unlist(chisq[i])))
443-
ddf <- c(ddf, abs(unlist(df[i+groupLength])-unlist(df[i])))
444-
dPrChisq <- c(dPrChisq, pchisq(q = abs(unlist(chisq[i+groupLength])- unlist(chisq[i])),
445-
df = abs(unlist(df[i+groupLength])-unlist(df[i])),
446-
lower.tail = FALSE))
447-
}
448-
fittab[["dchisq"]] <- dchisq
449-
fittab[["ddf"]] <- ddf
450-
fittab[["dPrChisq"]] <- dPrChisq
451-
452-
}
453-
454-
455-
# add warning footnotes
456-
if (!is.null(msc$warnings)) {
457-
if (!grepl(c("NaNs produced"), msc$warnings[[1]]$message))
458-
fittab$addFootnote(msc$warnings[[1]]$message)
343+
vv <- cSEM::verify(plsSemResults[[1]])
344+
if (any(unlist(vv))) {
345+
fittab$setError(gettext("At least one result is inadmissible."))
346+
return()
459347
}
460348

461-
# check if there are any problems with the results and give warnings
462-
warningmsgs <- c("Absolute standardized loading estimates are NOT all <= 1",
463-
"Construct VCV is NOT positive semi-definite",
464-
"Reliability estimates are NOT all <= 1",
465-
"Model-implied indicator VCV is NOT positive semi-definite")
349+
omf <- .withWarnings(cSEM::testOMF(.object = plsSemResults[[1]],
350+
.alpha = options[["significanceLevel"]],
351+
.R = options[["bollenStineBootstrapSamples"]],
352+
.saturated = options[["saturatedStructuralModel"]],
353+
.seed = if (options[["setSeed"]]) options[["seed"]]))
354+
fit <- omf$value
466355

467356
if (options[["group"]] == "") {
468-
for (i in seq_along(options[["models"]])) {
469-
warnings <- cSEM::verify(plsSemResults[[i]])[2:5]
470-
msgs <- warningmsgs[warnings]
357+
stat <- fit$Test_statistic
358+
fittab[["measure"]] <- names(stat)
359+
fittab[["statistic"]] <- stat
360+
fittab[["critValue"]] <- fit$Critical_value
471361

472-
for (j in seq_along(msgs)) {
473-
warningFootnote <- gettextf("WARNING! %1$s: %2$s", options[["models"]][[i]][["name"]], msgs[j])
474-
fittab$addFootnote(warningFootnote)
475-
}
476-
}
477362
} else {
478-
for (i in seq_along(options[["models"]])) {
479-
for (j in seq_along(plsSemResults[i])) {
480-
warnings <- cSEM::verify(plsSemResults[[i]][[j]])[2:5]
481-
msgs <- warningmsgs[warnings]
482-
483-
for (k in seq_along(msgs)) {
484-
warningFootnote <- gettextf("WARNING! %1$s, group %2$s: %3$s",
485-
options[["models"]][[i]][["name"]], names(plsSemResults[[i]])[[j]], msgs[k])
486-
fittab$addFootnote(warningFootnote)
487-
}
488-
}
489-
}
363+
stats <- sapply(fit, function(x) x$Test_statistic)
364+
fittab[["group"]] <- rep(names(fit), each = nrow(stats))
365+
fittab[["measure"]] <- rep(rownames(stats), ncol(stats))
366+
fittab[["statistic"]] <- c(stats)
367+
fittab[["critValue"]] <- c(sapply(fit, function(x) x$Critical_value))
490368
}
491369

492-
#create jasp state and store msc for additional output tables
493-
modSelCriteria <- createJaspState()
494-
modelContainer[["modSelCriteria"]] <- modSelCriteria
495-
modSelCriteria$dependOn(optionsFromObject = modelContainer)
496-
modSelCriteria$object <- msc
497370
}
498371

499372
# compute model selection criteria/ fit measures
@@ -527,16 +400,8 @@ checkCSemModel <- function(model, availableVars) {
527400

528401
modelContainer[["params"]] <- params
529402

530-
if (length(options[["models"]]) < 2) {
531-
.plsSemParameterTables(modelContainer[["results"]][["object"]][[1]], NULL, params, options, ready)
532-
} else {
403+
.plsSemParameterTables(modelContainer[["results"]][["object"]][[1]], NULL, params, options, ready)
533404

534-
for (i in seq_along(options[["models"]])) {
535-
fit <- modelContainer[["results"]][["object"]][[i]]
536-
name <- options[["models"]][[i]][["name"]]
537-
.plsSemParameterTables(fit, name, params, options, ready)
538-
}
539-
}
540405
}
541406

542407
# Parameter Estimates Tables
@@ -1213,32 +1078,18 @@ checkCSemModel <- function(model, availableVars) {
12131078
.plsSemAdditionalFits <- function(modelContainer, dataset, options, ready) {
12141079
if (!options[["additionalFitMeasures"]] || !is.null(modelContainer[["addfit"]])) return()
12151080

1216-
mfm <- modelContainer[["modSelCriteria"]]$object$value
1081+
msc <- modelContainer[["modSelCriteria"]][["object"]]
1082+
mfm <- msc$value
12171083

12181084
# create additional fits table
12191085
fitin <- createJaspTable(gettext("Additional Fit Measures"))
12201086
fitin$addColumnInfo(name = "index", title = gettext("Index"), type = "string")
1221-
if (length(options[["models"]]) < 2) {
1222-
if(options[["group"]] == "")
1223-
fitin$addColumnInfo(name = "value", title = gettext("Value"), type = "number")
1224-
else {
1225-
for (j in colnames(mfm$mfm)) {
1226-
fitin$addColumnInfo(name = paste0("value_", j), title = gettext(j), overtitle = options[["models"]][[1]][["name"]],
1227-
type = "number")
1228-
}
1229-
}
1230-
} else {
1231-
if(options[["group"]] == "") {
1232-
for (i in seq_along(options[["models"]])) {
1233-
fitin$addColumnInfo(name = paste0("value_", i), title = options[["models"]][[i]][["name"]], type = "number")
1234-
}
1235-
} else {
1236-
for (i in seq_along(options[["models"]])) {
1237-
for (j in colnames(mfm[[i]]$mfm)) {
1238-
fitin$addColumnInfo(name = paste0("value_",i,"_", j), title = gettext(j), overtitle = options[["models"]][[i]][["name"]],
1239-
type = "number")
1240-
}
1241-
}
1087+
if(options[["group"]] == "")
1088+
fitin$addColumnInfo(name = "value", title = gettext("Value"), type = "number")
1089+
else {
1090+
for (j in colnames(mfm$mfm)) {
1091+
fitin$addColumnInfo(name = paste0("value_", j), title = gettext(j), overtitle = gettext("Group"),
1092+
type = "number")
12421093
}
12431094
}
12441095

@@ -1247,7 +1098,6 @@ checkCSemModel <- function(model, availableVars) {
12471098

12481099
modelContainer[["addfit"]] <- fitin
12491100

1250-
12511101
if (!ready || modelContainer$getError()) return()
12521102

12531103
fitin[["index"]] <- c(
@@ -1271,47 +1121,34 @@ checkCSemModel <- function(model, availableVars) {
12711121

12721122
# fill additional fits table
12731123

1274-
if (length(options[["models"]]) < 2) {
1275-
1276-
if (options[["group"]] == "") {
1124+
if (options[["group"]] == "") {
12771125

1278-
fitin[["value"]] <- list(mfm$mfm$CFI, mfm$mfm$GFI, mfm$mfm$CN, mfm$mfm$IFI, mfm$mfm$NNFI,
1279-
mfm$mfm$NFI, mfm$mfm$RMSEA, mfm$mfm$RMS_theta, mfm$mfm$SRMR,
1280-
mfm$mfm$GoF, mfm$mfm$DG, mfm$mfm$DL, mfm$mfm$DML)
1126+
fitin[["value"]] <- list(mfm$mfm$CFI, mfm$mfm$GFI, mfm$mfm$CN, mfm$mfm$IFI, mfm$mfm$NNFI,
1127+
mfm$mfm$NFI, mfm$mfm$RMSEA, mfm$mfm$RMS_theta, mfm$mfm$SRMR,
1128+
mfm$mfm$GoF, mfm$mfm$DG, mfm$mfm$DL, mfm$mfm$DML)
12811129

1282-
} else {
1283-
for (j in colnames(mfm$mfm)) {
1284-
fitin[[paste0("value_", j)]] <- list(mfm$mfm["CFI", j], mfm$mfm["GFI", j], mfm$mfm["CN", j], mfm$mfm["IFI", j],
1285-
mfm$mfm["NNFI", j], mfm$mfm["NFI", j], mfm$mfm["RMSEA", j], mfm$mfm["RMS_theta", j],
1286-
mfm$mfm["SRMR", j], mfm$mfm["GoF", j], mfm$mfm["DG", j], mfm$mfm["DL", j],
1287-
mfm$mfm["DML", j])
1288-
1289-
}
1290-
}
12911130
} else {
1292-
if (options[["group"]] == "") {
1293-
for (i in seq_along(options[["models"]])) {
1294-
fitin[[paste0("value_", i)]] <- list(mfm[[i]]$mfm$CFI, mfm[[i]]$mfm$GFI, mfm[[i]]$mfm$CN, mfm[[i]]$mfm$IFI,
1295-
mfm[[i]]$mfm$NNFI, mfm[[i]]$mfm$NFI, mfm[[i]]$mfm$RMSEA,
1296-
mfm[[i]]$mfm$RMS_theta, mfm[[i]]$mfm$SRMR, mfm[[i]]$mfm$GoF,
1297-
mfm[[i]]$mfm$DG, mfm[[i]]$mfm$DL, mfm[[i]]$mfm$DML)
1298-
}
1131+
for (j in colnames(mfm$mfm)) {
1132+
fitin[[paste0("value_", j)]] <- list(mfm$mfm["CFI", j], mfm$mfm["GFI", j], mfm$mfm["CN", j], mfm$mfm["IFI", j],
1133+
mfm$mfm["NNFI", j], mfm$mfm["NFI", j], mfm$mfm["RMSEA", j], mfm$mfm["RMS_theta", j],
1134+
mfm$mfm["SRMR", j], mfm$mfm["GoF", j], mfm$mfm["DG", j], mfm$mfm["DL", j],
1135+
mfm$mfm["DML", j])
12991136

1137+
}
1138+
}
13001139

1140+
# add warning footnotes
1141+
if (!is.null(msc$warnings)) {
1142+
if (!grepl(c("NaNs produced"), msc$warnings[[1]]$message))
1143+
fitin$addFootnote(msc$warnings[[1]]$message)
1144+
}
13011145

1302-
} else {
1303-
for (i in seq_along(options[["models"]])) {
1304-
for (j in colnames(mfm[[i]]$mfm)) {
1305-
fitin[[paste0("value_",i,"_", j)]] <- list(mfm[[i]]$mfm["CFI",j], mfm[[i]]$mfm["GFI", j], mfm[[i]]$mfm["CN", j],
1306-
mfm[[i]]$mfm["IFI", j], mfm[[i]]$mfm["NNFI", j], mfm[[i]]$mfm["NFI", j],
1307-
mfm[[i]]$mfm["RMSEA", j], mfm[[i]]$mfm["RMS_theta", j], mfm[[i]]$mfm["SRMR", j],
1308-
mfm[[i]]$mfm["GoF", j], mfm[[i]]$mfm["DG", j], mfm[[i]]$mfm["DL", j],
1309-
mfm[[i]]$mfm["DML", j])
1146+
# check if there are any problems with the results and give warnings
1147+
warningmsgs <- c("Absolute standardized loading estimates are NOT all <= 1",
1148+
"Construct VCV is NOT positive semi-definite",
1149+
"Reliability estimates are NOT all <= 1",
1150+
"Model-implied indicator VCV is NOT positive semi-definite")
13101151

1311-
}
1312-
}
1313-
}
1314-
}
13151152
}
13161153

13171154
# Rsquared table
@@ -1345,7 +1182,8 @@ checkCSemModel <- function(model, availableVars) {
13451182
if (!ready || modelContainer$getError()) return()
13461183

13471184
# compute data and fill rsquared table
1348-
mfm <- modelContainer[["modSelCriteria"]]$object$value
1185+
msc <- modelContainer[["modSelCriteria"]][["object"]]
1186+
mfm <- msc$value
13491187
if (options[["group"]] == "") {
13501188

13511189
if (length(options[["models"]]) < 2) {
@@ -1494,7 +1332,9 @@ checkCSemModel <- function(model, availableVars) {
14941332
if (!ready || modelContainer$getError()) return()
14951333

14961334
# compute data and fill table
1497-
mfm <- modelContainer[["modSelCriteria"]]$object$value
1335+
msc <- modelContainer[["modSelCriteria"]][["object"]]
1336+
mfm <- msc$value
1337+
14981338
if (options[["group"]] == "") {
14991339

15001340
if (length(options[["models"]]) < 2) {

0 commit comments

Comments
 (0)