`r report.title`"
In kfa: K-Fold Cross Validation for Factor Analysis

knitr::opts_chunk$set(echo = FALSE)
flextable::set_flextable_defaults(fonts_ignore = TRUE)

plot.settings <- list(what = "std", whatLabels = "no", layout = "tree",
                        intercepts = FALSE, residuals = FALSE, thresholds = FALSE,
                        fade = FALSE, posCol = c("#000000"), # "#BF0000"), cut = load.flag, # can update to more nuanced coloring of plots
                        # edge.color = , # could create custom function to utilize this argument
                        weighted = TRUE, negDashed = TRUE, esize = 5,
                        manifests = vnames, reorder = FALSE)
border <- officer::fp_border(width = 2) # manual horizontal flextable border width

title: "r report.title" date: "r format(Sys.Date(), '%B %d, %Y')"

Overview

# of folds: r k

# of variables: r nvars

# of observations: r nobs

Maximum # of factors:

Allowed - r fac.allow
Extracted - r fac.max

Estimation: r opts$estimator

Missing Data: r opts$missing

\newpage

Model Summary

Fit across folds by factor model

ftn <- names(fit.table)
df <- ftn[grepl("df", ftn)] # naive or scaled?
index <- unique(gsub("mean.|range.", "", ftn[!ftn %in% c("model", df)]))
fit.map <- data.frame(col_keys = ftn,
                      top = c("model", df, rep(index, each = 2)),
                      bottom = c("model", df, rep(c("mean", "range"), times = length(index))))

fit.flex <- flextable::flextable(fit.table)
fit.flex <- flextable::colformat_double(fit.flex, j = -c(1,2), digits = digits)
fit.flex <- kfa:::two_level_flex(fit.flex, mapping = fit.map, vert.cols = c("model", df), border = border)
knitr::knit_print(fit.flex)

Count of folds out of r k with flagged problems

flagged.flex <- flextab_format(flagged, bold.type = "none", width = width, digits = digits)
flagged.flex <- flextable::vline(flagged.flex, j = 2, border = border)
knit_print(flagged.flex)

Notes:
'mode structure' is the number of folds the EFA identified the mode (most common) structure. This structure was then used in the CFA. 'mode structure' will be r k when the same structure was identified in every fold and < r k when multiple factor structures were identified. The value in 'mode structure' is the maximum value for all remaining columns. See Appendix for all structures.
'improper solution' is the number of folds with non-convergence or a non-positive definite matrix.
'high factor correlation' threshold set to r cor.flag.
'low scale reliability' threshold set to r rel.flag with $\omega_h$.
'low loading' threshold set to r load.flag.
blanks = not applicable

cat("**Best model in each fold by fit index**")
best.flex <- flextab_format(best.model, bold.type = "none", digits = digits)
knit_print(best.flex)

\newpage

Model Details

if(lavaan::lavInspect(models$cfas[[1]][[1]], "categorical")){
  what <- "omega_h"
  times <- 1
  j <- 2

} else {
  what <- c("omega_h", "alpha")
  times <- 2
  j <- c(2, 5)
}

rel.map <- data.frame(col_keys = names(krels$reliabilities[[1]]),
                      top = c("factor", rep(what, each = 3)),
                      bottom = c("factor", rep(c("mean", "range", "flag"), times = times)))

for(n in 1:m){
  cat("##", mnames[[n]])
  cat("\n\n")
  cat("**Factor Structure**")
  cat("\n\n")
  cat(gsub("\\*", "\\\\*", gsub("\n", "\n\n", kstructures[kstructures$model == mnames[[n]],]$structure)))
  cat("\n\n")
  if(plots == TRUE){
  ## find fold with admissible lavaan object for the model
for(f in 1:k){
  if(mnames[[n]] %in% names(models$cfas[[f]])){
    if(lavaan::lavInspect(models$cfas[[f]][[mnames[[n]]]], "converged") &
       suppressWarnings(lavaan::lavInspect(models$cfas[[f]][[mnames[[n]]]], "post.check"))){
      break  
    }
  } else {f <- 0}
}
if(f != 0){
  suppressWarnings(do.call(semPlot::semPaths, args = c(list(object = models$cfas[[f]][[mnames[[n]]]],
                                                            color = list(lat = palette.colors(n = n + 1, palette = "Okabe-Ito",
                                                                                              recycle = TRUE)[-1]),
                                                            title = FALSE),
                                                       plot.settings)))
} else{
  cat("*An admissible solution was not found for this model, so a plot could not be produced.*")
}
  }
  cat("\n\n")
  cat("**Standardized Loading Across Folds**")
  cat("\n\n")
  if(ncol(klambdas$loadings[[n]]) == 8){

      load.map <- data.frame(col_keys = names(klambdas$loadings[[n]]),
                      top = c("variable", rep("primary factor", 3), "heywood flag", rep("secondary factor", 3)),
                      bottom = c("variable", c("mean", "range", "loading flag", "heywood flag", "mean", "range", "loading flag")))
      lambda.flex <- flextable::flextable(klambdas$loadings[[n]])
      lambda.flex <- flextable::colformat_double(lambda.flex,
                                                 j = which(unlist(lapply(klambdas$loadings[[n]], is.numeric))),
                                                 digits = digits)
      lambda.flex <- flextable::align(lambda.flex, i = NULL, j = 1, align = "left", part = "body")
      lambda.flex <- two_level_flex(lambda.flex, mapping = load.map,
                                    vert.cols = c("variable", "heywood flag"), border = border)

  } else{
      lambda.flex <- flextab_format(klambdas$loadings[[n]], bold.type = "none", digits = digits)
      lambda.flex <- flextable::align(lambda.flex, i = NULL, j = 1, align = "left", part = "body")
  }
  cat(knit_print(lambda.flex))
  cat("Note: loadings flagged when <", load.flag, "in a fold. 'heywood flag' is the number of folds the variable's estimated residual variance was negative")
  cat("\n\n")
  if(n > 1){
  cat("**Mean Factor Correlations**")
  cat("\n\n")
  corr.flex <- flextab_format(kcorrs$correlations[[n]], bold.type = "none", digits = digits)
  corr.flex <- flextable::compose(corr.flex, i = 1, j = 1, value = flextable::as_paragraph(""), part = "header")
  corr.flex <- flextable::vline(corr.flex, j = ncol(kcorrs$correlations[[n]]) - 1, border = border)
  cat(knit_print(corr.flex))
  cat("Note: 'flag' is the number of folds the factor had a correlation >", cor.flag)
  cat("\n\n")
  }
  cat("**Scale Reliability Across Folds**")
  cat("\n\n")
  rel.flex <- flextable::flextable(krels$reliabilities[[n]])
  rel.flex <- flextable::colformat_double(rel.flex, j = j, digits = digits)
  rel.flex <- two_level_flex(rel.flex, mapping = rel.map, vert.cols = c("factor"), border = border)
  cat(knit_print(rel.flex))
  cat("Note: 'flag' is the number of folds the scale had a reliability <", rel.flag)
  cat("\n\n")
}

\newpage

Appendix

Within Fold Model Fit

index <- names(appendix)[!names(appendix) %in% "fold"]
index <- unique(sub(".[^.]*$", "", index))

ax <- length(index)*length(mnames)
if(ax <= 16){ # is the appendix a reasonable width?

  appendix.map <- data.frame(col_keys = names(appendix),
                      top = c("fold", rep(mnames, each = length(index))),
                      bottom = c("fold", rep(index, times = length(mnames))))

appendix.flex <- appendix_wrapper(appendix, appendix.map, border, digits)
appendix.flex


} else { # If not, split into two tables 

modsplit <- floor(16/length(index))
colsplit <- 1+length(index)*modsplit
appendix1 <- appendix[1:colsplit]
appendix2 <- appendix[c(1, (colsplit+1):length(appendix))]

appendix1.map <- data.frame(col_keys = names(appendix1),
                           top = c("fold", rep(mnames[1:modsplit], each = length(index))),
                           bottom = c("fold", rep(index, times = modsplit)))

appendix1.flex <- appendix_wrapper(appendix1, appendix1.map, border, digits)
appendix1.flex
# part 2 needs to be in a separate chunk for some reason
}

if(ax > 16){ 
  appendix2.map <- data.frame(col_keys = names(appendix2),
                            top = c("fold", rep(mnames[(modsplit+1):length(mnames)], each = length(index))),
                            bottom = c("fold", rep(index, times = length(mnames) - modsplit)))
  appendix2.flex <- appendix_wrapper(appendix2, appendix2.map, border, digits)
  appendix2.flex
}

All EFA Structures

strux <- models$efa.structures
for(n in 1:length(strux)){
  cat("### Factors:", n)
  cat("\n\n")
  for(s in seq_along(strux[[n]])){
    cat("**Factor Structure Option", s, "**")
    cat("\n\n")
    cat("**In Folds:", paste(strux[[n]][[s]]$folds, collapse = ", "), "**")
    cat("\n\n")
    if (strux[[n]][[s]]$structure == "") cat("Structure contained a factor with < 2 items") else cat(gsub("\n", "\n\n", strux[[n]][[s]]$structure))
    cat("\n\n")
  }
}