Nothing
`r ifelse(params$model_type == 'SEM', 'Structural Equation Modeling (SEM) Report', 'Confirmatory Factor Analysis (CFA) Report')`
In measureR: Tools for Educational and Psychological Measurement
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
library(lavaan)
library(knitr)
library(dplyr)
library(flextable)
# Configure flextable defaults for professional APA look
set_flextable_defaults(
font.family = "Times New Roman",
font.size = 11,
theme_fun = theme_apa,
padding = 1.5,
line_spacing = 1.0,
decimal.mark = params$dec
)
# Helper function to format numbers
fmt <- function(x, digits = 3) {
if(is.numeric(x)) {
formatC(x, format = "f", digits = digits, decimal.mark = params$dec)
} else {
x
}
}
Model Fit Assessment
This report presents the results of the r ifelse(params$model_type == 'SEM', 'Structural Equation Modeling (SEM)', 'Confirmatory Factor Analysis (CFA)'). The model was estimated using the r params$fit_final@Options$estimator estimator.
fit_summary <- fitMeasures(params$fit_final)
fit_names <- c("chisq", "df", "pvalue", "rmsea", "cfi", "tli", "srmr", "gfi", "agfi")
fit_vals <- fit_summary[fit_names]
fit_df <- data.frame(
Measure = c("Chi-square (χ²)", "Degrees of Freedom", "p-value", "RMSEA", "CFI", "TLI", "SRMR", "GFI", "AGFI"),
Value = as.numeric(fit_vals)
)
ft_fit <- flextable(fit_df) %>%
set_header_labels(Measure = "Fit Measure", Value = "Value") %>%
colformat_double(j = "Value", digits = 3) %>%
set_caption("Fit Indices for the Estimated Model") %>%
autofit()
ft_fit
m_final <- fitMeasures(params$fit_final)
# Determine interpretations
chisq_val <- m_final["chisq"]
df_val <- m_final["df"]
p_val <- m_final["pvalue"]
rmsea_val <- m_final["rmsea"]
rmsea_interp <- if(is.na(rmsea_val)) "an unknown" else if(rmsea_val < 0.05) "a good" else if(rmsea_val < 0.08) "an acceptable" else "a poor"
cfi_val <- m_final["cfi"]
cfi_interp <- if(is.na(cfi_val)) "an unknown" else if(cfi_val >= 0.95) "a good" else if(cfi_val >= 0.90) "an acceptable" else "a poor"
tli_val <- m_final["tli"]
srmr_val <- m_final["srmr"]
srmr_interp <- if(is.na(srmr_val)) "an unknown" else if(srmr_val < 0.05) "a good" else if(srmr_val < 0.08) "an acceptable" else "a poor"
p_text <- if(!is.na(p_val) && p_val < 0.001) "< .001" else paste0("= ", fmt(p_val, 3))
# Check if there's history
has_history <- !is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1
history_narrative <- ""
if (has_history) {
history_narrative <- "An initial model was evaluated, and based on modification indices, adjustments were made to improve the model fit. "
}
cat(sprintf(
"%sThe final model was evaluated using several fit indices based on standard criteria (e.g., Hu & Bentler, 1999; Kline, 2015). The Chi-square test resulted in χ²(%s) = %s, p %s. The Root Mean Square Error of Approximation (RMSEA) was %s, which indicates %s fit. The Comparative Fit Index (CFI) was %s and the Tucker-Lewis Index (TLI) was %s, suggesting %s fit. Furthermore, the Standardized Root Mean Square Residual (SRMR) was %s, denoting %s fit.\n",
history_narrative,
fmt(df_val, 0), fmt(chisq_val, 2), p_text,
fmt(rmsea_val, 3), rmsea_interp,
fmt(cfi_val, 3), fmt(tli_val, 3), cfi_interp,
fmt(srmr_val, 3), srmr_interp
))
if(!is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1) {
cat("## Model Modification History\n\n")
cat("The table below shows the progression of fit indices across all executed models, documenting the improvements achieved through modifications.\n\n")
}
if(!is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1) {
hist_df <- params$model_history_df
num_cols <- c("chisq", "df", "pvalue", "RMSEA", "CFI", "TLI", "SRMR")
for(col in num_cols) {
if(col %in% names(hist_df)) hist_df[[col]] <- as.numeric(hist_df[[col]])
}
# Select and arrange columns
display_cols <- intersect(c("Model", "Note", num_cols, "Heywood", "Status"), names(hist_df))
hist_df <- hist_df[, display_cols]
ft <- flextable(hist_df) %>%
colformat_double(j = c("chisq"), digits = 2) %>%
colformat_double(j = c("pvalue", "RMSEA", "CFI", "TLI", "SRMR"), digits = 3) %>%
set_caption("Table 1. Model Fit History Comparison") %>%
autofit()
# Highlight Heywood in history table
if("Heywood" %in% names(hist_df)) {
hw_idx <- which(hist_df$Heywood == "Yes")
if(length(hw_idx) > 0) {
ft <- ft %>% bg(i = hw_idx, j = "Heywood", bg = "#FFCCCC")
}
}
# Highlight Status
if("Status" %in% names(hist_df)) {
good_idx <- which(grepl("Good", hist_df$Status))
acc_idx <- which(grepl("Acceptable", hist_df$Status))
poor_idx <- which(grepl("Poor", hist_df$Status) | grepl("Heywood", hist_df$Status))
if(length(good_idx) > 0) ft <- ft %>% bg(i = good_idx, j = "Status", bg = "#d4edda")
if(length(acc_idx) > 0) ft <- ft %>% bg(i = acc_idx, j = "Status", bg = "#fff3cd")
if(length(poor_idx) > 0) ft <- ft %>% bg(i = poor_idx, j = "Status", bg = "#f8d7da")
}
ft
}
if(!is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1) {
cat("<br>")
cat("**Interpretation References:**<br>")
cat("<ul>")
cat("<li><b>Good Fit:</b> CFI ≥ 0.95, TLI ≥ 0.95, RMSEA < 0.05, SRMR < 0.05 (Hu & Bentler, 1999)</li>")
cat("<li><b>Acceptable Fit:</b> CFI ≥ 0.90, TLI ≥ 0.90, RMSEA < 0.08, SRMR < 0.08 (Kline, 2015)</li>")
cat("<li><span style='color:red;'><b>⚠ Heywood:</b></span> Negative variance detected (Chen et al., 2001)</li>")
cat("</ul>\n")
}
Measurement Model
The table below integrates the unstandardized and standardized factor loadings, standard errors, significance, and residual variances for the measurement model.
# Extract estimates
pe <- parameterEstimates(params$fit_final)
std <- standardizedSolution(params$fit_final)
# Loadings
loadings_pe <- pe[pe$op == "=~", c("lhs", "rhs", "est", "se", "pvalue")]
loadings_std <- std[std$op == "=~", c("lhs", "rhs", "est.std")]
loadings <- merge(loadings_pe, loadings_std, by = c("lhs", "rhs"), all.x = TRUE)
# Residual Variances
variances_pe <- pe[pe$op == "~~" & pe$lhs == pe$rhs, c("lhs", "est")]
colnames(variances_pe) <- c("rhs", "resid_var")
variances_std <- std[std$op == "~~" & std$lhs == std$rhs, c("lhs", "est.std")]
colnames(variances_std) <- c("rhs", "std_resid_var")
# Combine everything
meas_model <- merge(loadings, variances_pe, by = "rhs", all.x = TRUE)
meas_model <- merge(meas_model, variances_std, by = "rhs", all.x = TRUE)
meas_df <- data.frame(
Factor = meas_model$lhs,
Item = meas_model$rhs,
Estimate = meas_model$est,
Std_Estimate = meas_model$est.std,
SE = meas_model$se,
p_value = meas_model$pvalue,
Resid_Var = meas_model$resid_var
)
# Sort by factor
meas_df <- meas_df[order(meas_df$Factor, meas_df$Item), ]
# Format p-values
meas_df$p_value_fmt <- ifelse(meas_df$p_value < 0.001, "< .001", fmt(meas_df$p_value, 3))
# Check for Heywood cases
neg_var <- any(meas_df$Resid_Var < 0, na.rm = TRUE)
ft_meas <- flextable(meas_df[, c("Factor", "Item", "Estimate", "Std_Estimate", "SE", "p_value_fmt", "Resid_Var")]) %>%
set_header_labels(
Factor = "Factor",
Item = "Item",
Estimate = "Unstd. Loading",
Std_Estimate = "Std. Loading",
SE = "S.E.",
p_value_fmt = "p-value",
Resid_Var = "Residual Variance"
) %>%
colformat_double(j = c("Estimate", "Std_Estimate", "SE", "Resid_Var"), digits = 3) %>%
merge_v(j = "Factor") %>%
valign(j = "Factor", valign = "top") %>%
set_caption("Table 2. Measurement Model: Factor Loadings and Residual Variances") %>%
autofit()
# Highlight Heywood cases if any
if(neg_var) {
# find indices
idx <- which(meas_df$Resid_Var < 0)
ft_meas <- ft_meas %>%
bg(i = idx, bg = "#FFCCCC") %>%
add_footer_lines("Warning: Highlighted rows indicate negative residual variances (Heywood cases).")
}
ft_meas
Reliability and Validity
Average Variance Explained (AVE) and Composite Reliability (CR)
has_ave <- !is.null(params$ave) && !all(is.na(params$ave))
has_rel <- !is.null(params$relsem) && !all(is.na(params$relsem))
if(has_ave || has_rel) {
factors <- unique(c(names(params$ave), names(params$relsem)))
ave_cr_df <- data.frame(
Factor = factors,
AVE = if(has_ave) as.numeric(params$ave[factors]) else NA,
CR = if(has_rel) as.numeric(params$relsem[factors]) else NA,
row.names = NULL
)
ft_ave <- flextable(ave_cr_df) %>%
set_header_labels(Factor = "Factor", AVE = "AVE", CR = "Composite Reliability") %>%
colformat_double(j = c("AVE", "CR"), digits = 3) %>%
set_caption("Construct Reliability and Validity (AVE and CR)") %>%
autofit()
ft_ave
} else {
cat("AVE and CR values are not available for this model.\n")
}
if(has_ave || has_rel) {
cat("The reliability and convergent validity of the constructs were assessed using Composite Reliability (CR) and Average Variance Explained (AVE). Based on Hair et al. (2010) and Fornell & Larcker (1981), CR values above 0.70 and AVE values above 0.50 are indicative of acceptable reliability and convergent validity.\n")
}
cat("\n## Structural Model Paths\n\n")
cat("The following table presents the estimated regression paths between the structural/latent variables in the model.\n\n")
pe <- parameterEstimates(params$fit_final, standardized = TRUE)
struct_paths <- pe[pe$op == "~", ]
if (nrow(struct_paths) > 0) {
sp_df <- data.frame(
Dependent = struct_paths$lhs,
Predictor = struct_paths$rhs,
Estimate = struct_paths$est,
Std.Error = struct_paths$se,
z = struct_paths$z,
pvalue = struct_paths$pvalue,
Std.Estimate = struct_paths$std.all
)
ft_struct <- flextable(sp_df) %>%
colformat_double(j = c("Estimate", "Std.Error", "z", "Std.Estimate"), digits = 3) %>%
colformat_double(j = "pvalue", digits = 3) %>%
set_caption("Table 4. Structural Regression Paths") %>%
autofit()
ft_struct
} else {
# nothing
}
Heterotrait-Monotrait Ratio (HTMT)
if(!is.null(params$htmt) && !identical(params$htmt, NA) && !identical(params$htmt, "<NA>")) {
htmt_mat <- as.matrix(params$htmt)
# Replace upper triangle and diagonal with NA for cleaner display
htmt_mat[upper.tri(htmt_mat, diag = TRUE)] <- NA
htmt_df <- as.data.frame(htmt_mat)
htmt_df <- cbind(Factor = rownames(htmt_df), htmt_df)
rownames(htmt_df) <- NULL
ft_htmt <- flextable(htmt_df) %>%
colformat_double(j = 2:ncol(htmt_df), digits = 3, na_str = "") %>%
set_caption("Table 3. Discriminant Validity: Heterotrait-Monotrait Ratio (HTMT)") %>%
autofit()
ft_htmt
} else {
cat("HTMT ratio is not available for this model.\n")
}
Path Diagram
A <- semPaths(
params$fit_final,
what = ifelse(params$plot_standardized, "std", "est"),
style = params$plot_style,
layout = params$plot_layout,
residuals = params$plot_residuals,
exoCov = params$plot_exoCov,
edge.label.cex = params$plot_edge_label_size,
nCharNodes = 6,
nCharEdges = 6,
sizeLat = params$plot_nodesize_lat,
sizeMan = params$plot_nodesize_man,
sizeMan2 = params$plot_nodesize_man2,
rotation = params$plot_rotation,
color = list(man = params$man_col, lat = params$lat_col),
label.color = "black",
mar = c(2, 5, 5, 5),
bifactor = if(is.null(params$bifactor) || params$bifactor == "") NULL else params$bifactor,
esize = params$edgewidth,
edge.color = "black",
freeStyle = c(1, "black"),
fixedStyle = c(2, "black"),
fade = FALSE,
DoNotPlot = TRUE
)
# Render plot with significance markers
plot(semptools::mark_sig(semPaths_plot = A, object = params$fit_final,
alphas = c("*" = 0.05, "**" = 0.01, "***" = 0.001)))
References
- Chen, F., Bollen, K. A., Paxton, P., Curran, P. J., & Kirby, J. B. (2001). Improper solutions in structural equation models: Causes, consequences, and strategies. Sociological methods & research, 29(4), 468-508.
- Djidu, H. (2026). measureR: Tools for Educational and Psychological Measurement. R package. Available at: https://github.com/hdmeasure/measureR
- Djidu, H. (2026). measureR: Tools for educational and psychological measurement. https://doi.org/10.32614/CRAN.package.measureR. R package.
- Fornell, C., & Larcker, D. F. (1981). Evaluating structural equation models with unobservable variables and measurement error. Journal of Marketing Research, 18(1), 39-50.
- Hair, J. F., Black, W. C., Babin, B. J., & Anderson, R. E. (2010). Multivariate Data Analysis (7th ed.). Pearson.
- Hu, L., & Bentler, P. M. (1999). Cutoff criteria for fit indexes in covariance structure analysis: Conventional criteria versus new alternatives. Structural Equation Modeling: A Multidisciplinary Journal, 6(1), 1–55.
- Kline, R. B. (2015). Principles and practice of structural equation modeling (4th ed.). Guilford publications.
Generated by measureR
Try the measureR package in your browser
Any scripts or data that you put into this service are public.
measureR documentation built on May 15, 2026, 9:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE) library(lavaan) library(knitr) library(dplyr) library(flextable) # Configure flextable defaults for professional APA look set_flextable_defaults( font.family = "Times New Roman", font.size = 11, theme_fun = theme_apa, padding = 1.5, line_spacing = 1.0, decimal.mark = params$dec ) # Helper function to format numbers fmt <- function(x, digits = 3) { if(is.numeric(x)) { formatC(x, format = "f", digits = digits, decimal.mark = params$dec) } else { x } }
Model Fit Assessment
This report presents the results of the r ifelse(params$model_type == 'SEM', 'Structural Equation Modeling (SEM)', 'Confirmatory Factor Analysis (CFA)'). The model was estimated using the r params$fit_final@Options$estimator estimator.
fit_summary <- fitMeasures(params$fit_final) fit_names <- c("chisq", "df", "pvalue", "rmsea", "cfi", "tli", "srmr", "gfi", "agfi") fit_vals <- fit_summary[fit_names] fit_df <- data.frame( Measure = c("Chi-square (χ²)", "Degrees of Freedom", "p-value", "RMSEA", "CFI", "TLI", "SRMR", "GFI", "AGFI"), Value = as.numeric(fit_vals) ) ft_fit <- flextable(fit_df) %>% set_header_labels(Measure = "Fit Measure", Value = "Value") %>% colformat_double(j = "Value", digits = 3) %>% set_caption("Fit Indices for the Estimated Model") %>% autofit() ft_fit
m_final <- fitMeasures(params$fit_final) # Determine interpretations chisq_val <- m_final["chisq"] df_val <- m_final["df"] p_val <- m_final["pvalue"] rmsea_val <- m_final["rmsea"] rmsea_interp <- if(is.na(rmsea_val)) "an unknown" else if(rmsea_val < 0.05) "a good" else if(rmsea_val < 0.08) "an acceptable" else "a poor" cfi_val <- m_final["cfi"] cfi_interp <- if(is.na(cfi_val)) "an unknown" else if(cfi_val >= 0.95) "a good" else if(cfi_val >= 0.90) "an acceptable" else "a poor" tli_val <- m_final["tli"] srmr_val <- m_final["srmr"] srmr_interp <- if(is.na(srmr_val)) "an unknown" else if(srmr_val < 0.05) "a good" else if(srmr_val < 0.08) "an acceptable" else "a poor" p_text <- if(!is.na(p_val) && p_val < 0.001) "< .001" else paste0("= ", fmt(p_val, 3)) # Check if there's history has_history <- !is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1 history_narrative <- "" if (has_history) { history_narrative <- "An initial model was evaluated, and based on modification indices, adjustments were made to improve the model fit. " } cat(sprintf( "%sThe final model was evaluated using several fit indices based on standard criteria (e.g., Hu & Bentler, 1999; Kline, 2015). The Chi-square test resulted in χ²(%s) = %s, p %s. The Root Mean Square Error of Approximation (RMSEA) was %s, which indicates %s fit. The Comparative Fit Index (CFI) was %s and the Tucker-Lewis Index (TLI) was %s, suggesting %s fit. Furthermore, the Standardized Root Mean Square Residual (SRMR) was %s, denoting %s fit.\n", history_narrative, fmt(df_val, 0), fmt(chisq_val, 2), p_text, fmt(rmsea_val, 3), rmsea_interp, fmt(cfi_val, 3), fmt(tli_val, 3), cfi_interp, fmt(srmr_val, 3), srmr_interp ))
if(!is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1) { cat("## Model Modification History\n\n") cat("The table below shows the progression of fit indices across all executed models, documenting the improvements achieved through modifications.\n\n") }
if(!is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1) { hist_df <- params$model_history_df num_cols <- c("chisq", "df", "pvalue", "RMSEA", "CFI", "TLI", "SRMR") for(col in num_cols) { if(col %in% names(hist_df)) hist_df[[col]] <- as.numeric(hist_df[[col]]) } # Select and arrange columns display_cols <- intersect(c("Model", "Note", num_cols, "Heywood", "Status"), names(hist_df)) hist_df <- hist_df[, display_cols] ft <- flextable(hist_df) %>% colformat_double(j = c("chisq"), digits = 2) %>% colformat_double(j = c("pvalue", "RMSEA", "CFI", "TLI", "SRMR"), digits = 3) %>% set_caption("Table 1. Model Fit History Comparison") %>% autofit() # Highlight Heywood in history table if("Heywood" %in% names(hist_df)) { hw_idx <- which(hist_df$Heywood == "Yes") if(length(hw_idx) > 0) { ft <- ft %>% bg(i = hw_idx, j = "Heywood", bg = "#FFCCCC") } } # Highlight Status if("Status" %in% names(hist_df)) { good_idx <- which(grepl("Good", hist_df$Status)) acc_idx <- which(grepl("Acceptable", hist_df$Status)) poor_idx <- which(grepl("Poor", hist_df$Status) | grepl("Heywood", hist_df$Status)) if(length(good_idx) > 0) ft <- ft %>% bg(i = good_idx, j = "Status", bg = "#d4edda") if(length(acc_idx) > 0) ft <- ft %>% bg(i = acc_idx, j = "Status", bg = "#fff3cd") if(length(poor_idx) > 0) ft <- ft %>% bg(i = poor_idx, j = "Status", bg = "#f8d7da") } ft }
if(!is.null(params$model_history_df) && !identical(params$model_history_df, NA) && nrow(params$model_history_df) > 1) { cat("<br>") cat("**Interpretation References:**<br>") cat("<ul>") cat("<li><b>Good Fit:</b> CFI ≥ 0.95, TLI ≥ 0.95, RMSEA < 0.05, SRMR < 0.05 (Hu & Bentler, 1999)</li>") cat("<li><b>Acceptable Fit:</b> CFI ≥ 0.90, TLI ≥ 0.90, RMSEA < 0.08, SRMR < 0.08 (Kline, 2015)</li>") cat("<li><span style='color:red;'><b>⚠ Heywood:</b></span> Negative variance detected (Chen et al., 2001)</li>") cat("</ul>\n") }
Measurement Model
The table below integrates the unstandardized and standardized factor loadings, standard errors, significance, and residual variances for the measurement model.
# Extract estimates pe <- parameterEstimates(params$fit_final) std <- standardizedSolution(params$fit_final) # Loadings loadings_pe <- pe[pe$op == "=~", c("lhs", "rhs", "est", "se", "pvalue")] loadings_std <- std[std$op == "=~", c("lhs", "rhs", "est.std")] loadings <- merge(loadings_pe, loadings_std, by = c("lhs", "rhs"), all.x = TRUE) # Residual Variances variances_pe <- pe[pe$op == "~~" & pe$lhs == pe$rhs, c("lhs", "est")] colnames(variances_pe) <- c("rhs", "resid_var") variances_std <- std[std$op == "~~" & std$lhs == std$rhs, c("lhs", "est.std")] colnames(variances_std) <- c("rhs", "std_resid_var") # Combine everything meas_model <- merge(loadings, variances_pe, by = "rhs", all.x = TRUE) meas_model <- merge(meas_model, variances_std, by = "rhs", all.x = TRUE) meas_df <- data.frame( Factor = meas_model$lhs, Item = meas_model$rhs, Estimate = meas_model$est, Std_Estimate = meas_model$est.std, SE = meas_model$se, p_value = meas_model$pvalue, Resid_Var = meas_model$resid_var ) # Sort by factor meas_df <- meas_df[order(meas_df$Factor, meas_df$Item), ] # Format p-values meas_df$p_value_fmt <- ifelse(meas_df$p_value < 0.001, "< .001", fmt(meas_df$p_value, 3)) # Check for Heywood cases neg_var <- any(meas_df$Resid_Var < 0, na.rm = TRUE) ft_meas <- flextable(meas_df[, c("Factor", "Item", "Estimate", "Std_Estimate", "SE", "p_value_fmt", "Resid_Var")]) %>% set_header_labels( Factor = "Factor", Item = "Item", Estimate = "Unstd. Loading", Std_Estimate = "Std. Loading", SE = "S.E.", p_value_fmt = "p-value", Resid_Var = "Residual Variance" ) %>% colformat_double(j = c("Estimate", "Std_Estimate", "SE", "Resid_Var"), digits = 3) %>% merge_v(j = "Factor") %>% valign(j = "Factor", valign = "top") %>% set_caption("Table 2. Measurement Model: Factor Loadings and Residual Variances") %>% autofit() # Highlight Heywood cases if any if(neg_var) { # find indices idx <- which(meas_df$Resid_Var < 0) ft_meas <- ft_meas %>% bg(i = idx, bg = "#FFCCCC") %>% add_footer_lines("Warning: Highlighted rows indicate negative residual variances (Heywood cases).") } ft_meas
Reliability and Validity
Average Variance Explained (AVE) and Composite Reliability (CR)
has_ave <- !is.null(params$ave) && !all(is.na(params$ave)) has_rel <- !is.null(params$relsem) && !all(is.na(params$relsem)) if(has_ave || has_rel) { factors <- unique(c(names(params$ave), names(params$relsem))) ave_cr_df <- data.frame( Factor = factors, AVE = if(has_ave) as.numeric(params$ave[factors]) else NA, CR = if(has_rel) as.numeric(params$relsem[factors]) else NA, row.names = NULL ) ft_ave <- flextable(ave_cr_df) %>% set_header_labels(Factor = "Factor", AVE = "AVE", CR = "Composite Reliability") %>% colformat_double(j = c("AVE", "CR"), digits = 3) %>% set_caption("Construct Reliability and Validity (AVE and CR)") %>% autofit() ft_ave } else { cat("AVE and CR values are not available for this model.\n") }
if(has_ave || has_rel) { cat("The reliability and convergent validity of the constructs were assessed using Composite Reliability (CR) and Average Variance Explained (AVE). Based on Hair et al. (2010) and Fornell & Larcker (1981), CR values above 0.70 and AVE values above 0.50 are indicative of acceptable reliability and convergent validity.\n") }
cat("\n## Structural Model Paths\n\n") cat("The following table presents the estimated regression paths between the structural/latent variables in the model.\n\n")
pe <- parameterEstimates(params$fit_final, standardized = TRUE) struct_paths <- pe[pe$op == "~", ] if (nrow(struct_paths) > 0) { sp_df <- data.frame( Dependent = struct_paths$lhs, Predictor = struct_paths$rhs, Estimate = struct_paths$est, Std.Error = struct_paths$se, z = struct_paths$z, pvalue = struct_paths$pvalue, Std.Estimate = struct_paths$std.all ) ft_struct <- flextable(sp_df) %>% colformat_double(j = c("Estimate", "Std.Error", "z", "Std.Estimate"), digits = 3) %>% colformat_double(j = "pvalue", digits = 3) %>% set_caption("Table 4. Structural Regression Paths") %>% autofit() ft_struct } else { # nothing }
Heterotrait-Monotrait Ratio (HTMT)
if(!is.null(params$htmt) && !identical(params$htmt, NA) && !identical(params$htmt, "<NA>")) { htmt_mat <- as.matrix(params$htmt) # Replace upper triangle and diagonal with NA for cleaner display htmt_mat[upper.tri(htmt_mat, diag = TRUE)] <- NA htmt_df <- as.data.frame(htmt_mat) htmt_df <- cbind(Factor = rownames(htmt_df), htmt_df) rownames(htmt_df) <- NULL ft_htmt <- flextable(htmt_df) %>% colformat_double(j = 2:ncol(htmt_df), digits = 3, na_str = "") %>% set_caption("Table 3. Discriminant Validity: Heterotrait-Monotrait Ratio (HTMT)") %>% autofit() ft_htmt } else { cat("HTMT ratio is not available for this model.\n") }
Path Diagram
A <- semPaths( params$fit_final, what = ifelse(params$plot_standardized, "std", "est"), style = params$plot_style, layout = params$plot_layout, residuals = params$plot_residuals, exoCov = params$plot_exoCov, edge.label.cex = params$plot_edge_label_size, nCharNodes = 6, nCharEdges = 6, sizeLat = params$plot_nodesize_lat, sizeMan = params$plot_nodesize_man, sizeMan2 = params$plot_nodesize_man2, rotation = params$plot_rotation, color = list(man = params$man_col, lat = params$lat_col), label.color = "black", mar = c(2, 5, 5, 5), bifactor = if(is.null(params$bifactor) || params$bifactor == "") NULL else params$bifactor, esize = params$edgewidth, edge.color = "black", freeStyle = c(1, "black"), fixedStyle = c(2, "black"), fade = FALSE, DoNotPlot = TRUE ) # Render plot with significance markers plot(semptools::mark_sig(semPaths_plot = A, object = params$fit_final, alphas = c("*" = 0.05, "**" = 0.01, "***" = 0.001)))
References
- Chen, F., Bollen, K. A., Paxton, P., Curran, P. J., & Kirby, J. B. (2001). Improper solutions in structural equation models: Causes, consequences, and strategies. Sociological methods & research, 29(4), 468-508.
- Djidu, H. (2026). measureR: Tools for Educational and Psychological Measurement. R package. Available at: https://github.com/hdmeasure/measureR
- Djidu, H. (2026). measureR: Tools for educational and psychological measurement. https://doi.org/10.32614/CRAN.package.measureR. R package.
- Fornell, C., & Larcker, D. F. (1981). Evaluating structural equation models with unobservable variables and measurement error. Journal of Marketing Research, 18(1), 39-50.
- Hair, J. F., Black, W. C., Babin, B. J., & Anderson, R. E. (2010). Multivariate Data Analysis (7th ed.). Pearson.
- Hu, L., & Bentler, P. M. (1999). Cutoff criteria for fit indexes in covariance structure analysis: Conventional criteria versus new alternatives. Structural Equation Modeling: A Multidisciplinary Journal, 6(1), 1–55.
- Kline, R. B. (2015). Principles and practice of structural equation modeling (4th ed.). Guilford publications.
Generated by measureR
Try the measureR package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.