extractParameters <- function(fittedModel, alpha = 0.05, display = TRUE) {
nGroups <- fittedModel@Data@ngroups # Look for multigroup
etaIntFree <- fittedModel@Options$int.lv.free # Look for standardization
nItems <- length(lavaan::lavNames(fittedModel))
if (nGroups > 1) {
parDf <- lavaan::parameterEstimates(fittedModel,
zstat = FALSE,
pvalue = FALSE,
rsquare = FALSE)[, -c(1, 2, 3, 4)]
parDf$group[parDf$group == 0] <- c(rep(1:nGroups, each = nItems), 1:nGroups)
stdDf <- lavaan::standardizedSolution(fittedModel,
zstat = FALSE,
pvalue = FALSE)[grep("lambda", parDf$label), -c(1, 2, 3)]
stdDf$label <- rep(paste("std", 1:nItems, sep = "_"), nGroups)
} else {
parDf <- cbind(
group = 1,
lavaan::parameterEstimates(fittedModel,
zstat = FALSE,
pvalue = FALSE,
rsquare = FALSE)[, -c(1, 2, 3)]
)
stdDf <- cbind(
group = 1,
lavaan::standardizedSolution(fittedModel,
zstat = FALSE,
pvalue = FALSE)[grep("lambda", parDf$label), -c(1, 2, 3)]
)
stdDf$label <- paste("std", 1:nItems, sep = "_")
}
names(stdDf)[2] <- "est"
df <- rbind(parDf, stdDf[, names(parDf)])
## CIs for reliabilities: ------------------------------------------------------------------------------------------------
rels <- df$est[grep("rel_", df$label)]
relsSE <- df$se[grep("rel_", df$label)]
relsLogit <- log(rels / (1 - rels))
relsLogitSE <- relsSE / (rels * (1 - rels))
relsCiL <- 1 / (1 + exp(-relsLogit + qnorm(1 - alpha / 2) * relsLogitSE))
relsCiU <- 1 / (1 + exp(-relsLogit - qnorm(1 - alpha / 2) * relsLogitSE))
df$ci.lower[grep("rel_", df$label)] <- relsCiL
df$ci.upper[grep("rel_", df$label)] <- relsCiU
# -----------------------------------------------------------------------------------------------------------------------
# If there are fixed parameters, omit se and ci
df[df$se == 0 | is.na(df$se), c("se", "ci.lower", "ci.upper")] <- NA
df$CI <- ifelse(is.na(df$ci.lower) & is.na(df$ci.upper), NA, sprintf("[%.3f, %.3f]", df$ci.lower, df$ci.upper))
df <- df[grep("epsilon|alpha|lambda|eta|rel|std", df$label), -c(5, 6)]
if (display) {
# Prepare the names for HTML
df$label <- gsub("_g(\\d+)", "", df$label)
df$label <- gsub("sigma_epsilon_(\\d+)",
"σ̂²<sub>ε<sub>\\1</sub></sub>",
df$label)
df$label <- gsub("lambda_(\\d+)",
"λ̂<sub>\\1</sub>",
df$label)
df$label <- gsub("alpha_(\\d+)",
"α̂<sub>\\1</sub>",
df$label)
df$label[grep("rel_", df$label)] <- sprintf("R̂<sub>%i</sub>", 1:length(lavaan::lavNames(fittedModel)))
df$label[grep("sumrel", df$label)] <- "R̂<sub>Σ</sub>"
df$label[grep("sigma_eta", df$label)] <- "σ̂²<sub>η</sub>"
df$label[grep("mu_eta", df$label)] <- "μ̂<sub>η</sub>"
# Split by groups and bind -----------------------------------------------------------------------------------------------
splitDf <- lapply(
split(df, df$group),
function(subDf) {
rbind(cbind(Item = lavaan::lavNames(fittedModel),
subDf[grep("lambda", subDf$label), -1],
subDf[grep("std", subDf$label), -c(1, 2)],
subDf[grep("alpha", subDf$label), -1],
subDf[grep("epsilon", subDf$label), -1],
subDf[grep("R̂", subDf$label)[1:nItems], -1]),
c(Item = NA,
label = NA,
est = NA,
se = NA,
CI = NA,
est = NA,
se = NA,
CI = NA,
if (etaIntFree) subDf[subDf$label == "μ̂<sub>η</sub>", -1] else c(label = NA, est = NA, se = NA, CI = NA),
subDf[subDf$label == "σ̂²<sub>η</sub>", -1],
subDf[grep("R̂<sub>Σ", subDf$label), -1])
)
}
)
boundDf <- do.call(rbind, splitDf)
rownames(boundDf) <- NULL
boundDf
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.