Skip to content

Commit

Permalink
change layout of multigroup fit table
Browse files Browse the repository at this point in the history
  • Loading branch information
@juliuspfadt
juliuspfadt committed Feb 21, 2024
1 parent 5f73b59 commit f10573d
Show file tree
Hide file tree
Showing 2 changed files with 82 additions and 71 deletions.
122 changes: 59 additions & 63 deletions R/sem.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -445,6 +445,11 @@ checkLavaanModel <- function(model, availableVars) {
fittab$position <- 0

fittab$addColumnInfo(name = "Model", title = "", type = "string" , combine = TRUE)

if (options[["group"]] != "") {
fittab$addColumnInfo(name = "group", title = gettext("Group"), type = "string" )
}

fittab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" )
fittab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" )
fittab$addColumnInfo(name = "N", title = gettext("n"), type = "integer")
Expand All @@ -454,43 +459,17 @@ checkLavaanModel <- function(model, availableVars) {
overtitle = gettext("Baseline test"))
fittab$addColumnInfo(name = "PrChisq", title = gettext("p"), type = "pvalue",
overtitle = gettext("Baseline test"))
fittab$addColumnInfo(name = "dchisq", title = gettext("&#916;&#967;&sup2;"), type = "number" ,
overtitle = gettext("Difference test"))
fittab$addColumnInfo(name = "ddf", title = gettext("&#916;df"), type = "integer",
overtitle = gettext("Difference test"))
fittab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" ,
overtitle = gettext("Difference test"))

modelContainer[["fittab"]] <- fittab

if (options[["group"]] != "") {
grouptab <- createJaspTable(title = gettext("Model fit by group"))
grouptab$dependOn("models")
grouptab$position <- 0.05

grouptab$addColumnInfo(name = "Model", title = "", type = "string" , combine = TRUE)
grouptab$addColumnInfo(name = "group", title = gettext("Group"), type = "string" )
grouptab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" )
grouptab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" )
grouptab$addColumnInfo(name = "N", title = gettext("n"), type = "integer")
grouptab$addColumnInfo(name = "Chisq", title = "\u03C7\u00B2", type = "number" ,
overtitle = gettext("Baseline test"))
grouptab$addColumnInfo(name = "Df", title = gettext("df"), type = "integer",
overtitle = gettext("Baseline test"))
grouptab$addColumnInfo(name = "PrChisq", title = gettext("p"), type = "pvalue",
overtitle = gettext("Baseline test"))
if (length(options[["models"]]) > 1) {
grouptab$addColumnInfo(name = "dchisq", title = "\u0394\u03C7\u00B2", type = "number" ,
overtitle = gettext("Difference test"))
grouptab$addColumnInfo(name = "ddf", title = gettextf("%1$sdf", "\u0394"), type = "integer",
overtitle = gettext("Difference test"))
grouptab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" ,
overtitle = gettext("Difference test"))
}

modelContainer[["grouptab"]] <- grouptab
if (length(options[["models"]]) > 1) {
fittab$addColumnInfo(name = "dchisq", title = "\u0394\u03C7\u00B2", type = "number" ,
overtitle = gettext("Difference test"))
fittab$addColumnInfo(name = "ddf", title = gettextf("%1$sdf", "\u0394"), type = "integer",
overtitle = gettext("Difference test"))
fittab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" ,
overtitle = gettext("Difference test"))
}

modelContainer[["fittab"]] <- fittab

if (!ready) return()

Expand Down Expand Up @@ -533,33 +512,40 @@ checkLavaanModel <- function(model, availableVars) {
lrt$value[["Df"]] <- chis[2, ]
lrt$value[["PrChisq"]] <- chis[3, ]


lrt$value[1,5:7] <- NA
chiSq <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat}))
dfs <- unlist(lapply(semResults, function(x) {round(lavaan::lavInspect(x, what = "test")[[testName]]$df, 3)}))
}

fittab[["Model"]] <- rownames(lrt$value)
fittab[["AIC"]] <- lrt$value[["AIC"]]
fittab[["BIC"]] <- lrt$value[["BIC"]]
fittab[["N"]] <- Ns
fittab[["Chisq"]] <- chiSq
fittab[["Df"]] <- dfs
fittab[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE)
fittab[["dchisq"]] <- lrt$value[["Chisq diff"]]
fittab[["ddf"]] <- lrt$value[["Df diff"]]
fittab[["dPrChisq"]] <- lrt$value[["Pr(>Chisq)"]]
dtFill <- data.frame(matrix(ncol = 0, nrow = length(rownames(lrt$value))))

dtFill[["Model"]] <- rownames(lrt$value)
dtFill[["AIC"]] <- lrt$value[["AIC"]]
dtFill[["BIC"]] <- lrt$value[["BIC"]]
dtFill[["N"]] <- Ns
dtFill[["Chisq"]] <- chiSq
dtFill[["Df"]] <- dfs
dtFill[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE)

if (length(options[["models"]]) > 1) {
dtFill[["dchisq"]] <- lrt$value[["Chisq diff"]]
dtFill[["ddf"]] <- lrt$value[["Df diff"]]
dtFill[["dPrChisq"]] <- lrt$value[["Pr(>Chisq)"]]
}

# add warning footnote
fnote <- ""
if (!is.null(lrt$warnings)) {
fittab$addFootnote(gsub("lavaan WARNING: ", "", lrt$warnings[[1]]$message))
fnote <- paste0(fnote, gsub("lavaan WARNING: ", "", lrt$warnings[[1]]$message))
}

if(options$naAction == "listwise"){
nrm <- nrow(dataset) - lavaan::lavInspect(semResults[[1]], "ntotal")
if (nrm != 0) {
missingFootnote <- gettextf("A total of %g cases were removed due to missing values. You can avoid this by choosing 'FIML' under 'Missing Data Handling' in the Estimation options.",
nrm)
fittab$addFootnote(message = missingFootnote)
fnote <- paste0(fnote, missingFootnote)
}
}

Expand Down Expand Up @@ -587,12 +573,14 @@ checkLavaanModel <- function(model, availableVars) {
if (length(semResults) > 1)
ftext <- gettextf("Baseline tests based on %s. Difference tests based on a function of two standard test-statistics.", testname)

fittab$addFootnote(message = ftext)
fnote <- paste0(fnote, ftext)

}

if (options$estimator %in% c("dwls", "gls", "wls", "uls")) {
fittab$addFootnote(message = gettext("The AIC, BIC and additional information criteria are only available with ML-type estimators"))
fnote <- paste0(fnote, gettext("The AIC, BIC and additional information criteria are only available with ML-type estimators"))
}

if (options[["group"]] != "") {

groupNames <- semResults[[1]]@Data@group.label
Expand Down Expand Up @@ -621,7 +609,7 @@ checkLavaanModel <- function(model, availableVars) {
fit_group <- try(do.call(lavaan::lavaan, lav_args))
if (isTryError(fit_group)) {
errormsg <- gettextf("The model fit by group is unavailable for the specified model: %s", options[["models"]][[i]][["name"]])
grouptab$setError(errormsg)
fittab$setError(errormsg)
break
}
results_grouped[[k]] <- fit_group
Expand All @@ -636,14 +624,17 @@ checkLavaanModel <- function(model, availableVars) {
bic <- vapply(results_grouped, BIC, 0)
Ns <- vapply(results_grouped, lavaan::lavInspect, 0, what = "ntotal")

grouptab[["Model"]] <- models
grouptab[["group"]] <- rep(groupNames, length(rownames(lrt$value)))
grouptab[["AIC"]] <- aic
grouptab[["BIC"]] <- bic
grouptab[["N"]] <- Ns
grouptab[["Chisq"]] <- chiSq
grouptab[["Df"]] <- dfs
grouptab[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE)
dtFillGroup <- data.frame(matrix(ncol = 0, nrow = length(models)))

dtFillGroup[["Model"]] <- models
dtFillGroup[["group"]] <- rep(groupNames, length(rownames(lrt$value)))
dtFillGroup[["AIC"]] <- aic
dtFillGroup[["BIC"]] <- bic
dtFillGroup[["N"]] <- Ns
dtFillGroup[["Chisq"]] <- chiSq
dtFillGroup[["Df"]] <- dfs
dtFillGroup[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE)

if (length(semResults) > 1) {
dchisq <- rep(NA, length(groupNames))
ddf <- rep(NA, length(groupNames))
Expand All @@ -654,15 +645,20 @@ checkLavaanModel <- function(model, availableVars) {
ddf <- c(ddf, lrt[2, "Df diff"])
dPrChisq <- c(dPrChisq, lrt[2, "Pr(>Chisq)"])
}
grouptab[["dchisq"]] <- dchisq
grouptab[["ddf"]] <- ddf
grouptab[["dPrChisq"]] <- dPrChisq
dtFillGroup[["dchisq"]] <- dchisq
dtFillGroup[["ddf"]] <- ddf
dtFillGroup[["dPrChisq"]] <- dPrChisq

}
if (test != "standard") {
grouptab$addFootnote(message = ftext)
}
dtFill[["group"]] <- gettext("all")
dtFill <- dtFill[, c(1, ncol(dtFill), 2:(ncol(dtFill)-1))]
dtFill <- rbind(dtFill, NA, dtFillGroup)

}

fittab$setData(dtFill)
fittab$addFootnote(message = fnote)

}

.semParameters <- function(modelContainer, dataset, options, ready) {
Expand Down
31 changes: 23 additions & 8 deletions tests/testthat/test-sem.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -126,14 +126,29 @@ test_that("Multigroup, multimodel SEM works", {

results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options)

fittab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]]

expect_equal_tables(fittab, list(3189.26691715402, 3383.93591869107, 85.6796813843025, 70, "default",
75, 0.0980338951401389, "", "", "", 3184.34803034567, 3372.06456754211,
87.9549367720072, 73, "constrained", 75, 0.111927575441429,
0.647754490401136, 1.65156784895958, 3, 3181.07183366569, 3361.83590652152,
92.7433708195597, 76, "more constrained", 75, 0.0929761753671129,
0.110596895607244, 6.02091896557718, 3), "Model fit table")

table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]]
jaspTools::expect_equal_tables(table,
list(3189.26691715401, 3383.93591869106, 85.6796813843018, 70, "default",
75, 0.0980338951401478, "", "", "", "all", 3184.34803034567,
3372.06456754211, 87.9549367720082, 73, "constrained", 75, 0.111927575441416,
0.647754490400887, 1.65156784896069, 3, "all", 3181.07183366569,
3361.83590652152, 92.7433708195334, 76, "more constrained",
75, 0.0929761753674234, 0.110596895611682, 6.02091896548516,
3, "all", "", "", "", "", "", "", "", "", "", "", "", 1554.81154499834,
1622.4700973294, 51.6035277328312, 35, "default", 37, 0.0348827227017056,
"", "", "", 1, 1634.45537215556, 1703.23399086407, 34.0761536514705,
35, "default", 38, 0.512542051610508, "", "", "", 2, 1549.89265811708,
1612.71845671021, 53.4279668719259, 38, "constrained", 37, 0.0495817824685928,
0.647670189286977, 1.65194336157068, 3, 1, 1634.45537215827,
1703.23399086677, 34.5269699000823, 35, "constrained", 38, 0.490791865857913,
"", 0, 0, 2, 1549.89265811344, 1612.71845670656, 54.5525537466071,
38, "more constrained", 37, 0.0399564191890052, "", 0, 0, 1,
1631.17917549794, 1695.04503572727, 38.1908170729263, 38, "more constrained",
38, 0.460812777513654, 0.110723813861605, 6.01828887667228,
3, 2), "Model fit table")



grouptab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_grouptab"]][["data"]]
expect_equal_tables(grouptab, list(1554.81154499834, 1622.4700973294, 51.6035277328317, 35, "default",
Expand Down

0 comments on commit f10573d

Please sign in to comment.