---
title: "`r ifelse(params$model_type == 'SEM', 'Structural Equation Modeling (SEM) Report', 'Confirmatory Factor Analysis (CFA) Report')`"
date: "`r Sys.Date()`"
output: 
  html_document:
    theme: flatly
    toc: true
    toc_float: true
params:
  model_type: "CFA"
  fit_final: NA
  fit_initial: NA
  model_history_df: NA
  dec: "."
  ave: NA
  relsem: NA
  htmt: NA
  plot_standardized: TRUE
  plot_style: "lisrel"
  plot_layout: "tree2"
  plot_residuals: FALSE
  plot_exoCov: FALSE
  plot_edge_label_size: 0.75
  plot_nodesize_lat: 5
  plot_nodesize_man: 5
  plot_nodesize_man2: 2.5
  plot_rotation: 4
  man_col: "#A1E3F9"
  lat_col: "#FFFFBA"
  bifactor: ""
  edgewidth: 0.3
  plotwidth: 10
  plotheight: 8
---

<style>
  body, p, table, td, th {
    font-family: "Times New Roman", Times, serif;
    line-height: 1.0 !important;
    font-size: 14px;
  }
  h1, h2, h3, h4, h5, h6 {
    font-family: "Times New Roman", Times, serif;
    line-height: 1.1;
  }
</style>

```{r setup, include=FALSE}
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.

```{r fit-measures}
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
```

```{r final-model-info, results='asis'}
  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
  ))
```

```{r model-history-section, results='asis', echo=FALSE}
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")
}
```

```{r model-history, echo=FALSE}
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
}
```

```{r model-history-refs, results='asis', echo=FALSE}
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.

```{r 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)

```{r ave-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")
}
```

```{r reliability-info, results='asis'}
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")
}
```

```{r structural-model-headers, results='asis', echo=FALSE, eval=(params$model_type == "SEM")}
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")
```

```{r structural-model-table, echo=FALSE, eval=(params$model_type == "SEM")}
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)

```{r 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

```{r path-plot, fig.width=params$plotwidth, fig.height=params$plotheight, dpi=300}
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*
