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

```{r modelfit, ft.align = "left", results='asis'}
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**

```{r flagged, ft.align = "left", results='asis'}
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  


```{r bestmodel, ft.align = "left", results='asis', eval=FALSE}
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

```{r details, ft.align = "left", results = 'asis', warning = FALSE, message = FALSE, fig.height = 4, fig.width = 6}

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

```{r appendixfits, ft.align = "left", results='asis'}
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
}
```

```{r appendix2, ft.align = "left", results='asis'}
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

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

```

