---
title: "Confirmatory Factor Analysis"
---

\normalsize

```{whites, eval=FALSE, echo = eval_code}
# Model Definition (please remark the single quotation marks enclosing the equations)
model <- 
'
```

```{r, dev="cairo_pdf", eval=eval_code}
model <- params$model
modelsplit <- unlist(strsplit(model, split="\n"))
modelsplit <- modelsplit[modelsplit != ""]
modelsplit <- gsub(" ", "", modelsplit, fixed = TRUE)
for (i in 1:length(modelsplit)){
  cat(modelsplit[i],fill=TRUE)
}
```

```{whites, eval=FALSE, echo = eval_code}
'
```

```{whites, eval=FALSE, echo = indic_missings}
# Model Fit
fit <- cfa(model, data=df, missing="fiml", estimator="ML") 
# Parameter Estimates
pe <- parameterEstimates(fit, rsquare = TRUE)
```     

```{whites, eval=FALSE, echo = !indic_missings}
# Model Fit Unstandardized 
fit <- cfa(model, data=df, estimator="ML") 
## Parameter Estimates
pe <- parameterEstimates(fit, rsquare = TRUE)
```    

```{whites, eval=FALSE, echo = eval_code}
# Check Model Equations
info <- inspect(fit, what="list")
info <- info[,c(2,3,4,5,8)]
```               

```{whites, eval=FALSE, echo = indic_missings}
# Model Fit Standardized Observed Variables
fit2 <- cfa(model, data=df, missing="fiml", estimator="ML", std.ov=TRUE)
## Parameter Estimates
pe_stand <- standardizedsolution(fit2, type="std.all")
```   

```{whites, eval=FALSE, echo = !indic_missings}
# Model Fit Standardized Observed Variables
fit2 <- cfa(model, data=df, estimator="ML", std.ov=TRUE) 
## Parameter Estimates
pe_stand <- standardizedsolution(fit2, type="std.all")
```   

```{whites, eval=FALSE, echo = eval_code}
# Outputs
## Summary Unstandardized Parameter Estimates 
summary(fit, fit.measures=TRUE)
```

```{whites, eval=FALSE, echo = eval_code}
## Summary Completely Standardized Parameter Estimates
standardizedSolution(fit2, type="std.all", output="text")
```  

```{whites, eval=FALSE, echo = eval_code}
## Communality
if ("label" %in% colnames(pe)) pe$label <- NULL
r2 <- pe[pe$op=="r2",c(1,4)]
r2 <- r2[order(r2$lhs),]
colnames(r2) <- c("Variable","Communality")
rownames(r2) <- NULL
r2
```  

```{whites, eval=FALSE, echo = nfactors_indic}
## Factor Discriminant Validity
discr <- suppressWarnings(discriminantValidity(fit, cutoff = 0.85))
discr <- discr[,c(1:4,11:13)]
discr <- discr[!is.na(discr$`Pr(>Chisq)`),]
kable(discr,caption="Factor Discriminant Validity Test at Cutoff 0.85",digits=3,
      row.names = NA, linesep = '', col.names = 
        c("","","","Factor Correlation","Chisq diff","Df diff","P-Value"), format="simple")
``` 

```{whites, eval=FALSE, echo = eval_code}
## Factor Reliability
rel <- reliability(fit, return.total = TRUE, dropSingle = FALSE, 
                   omit.imps = c("no.conv", "no.se", "no.npd"))
rel <- rel[3:5,]
rel <- as.data.frame(rel)
rownames(rel) <- c("Omega (Bentler)","Omega (McDonald)","AVE")
### Colname for single factor case 
if (length(fit@pta$vnames$lv.x[[1]])==1) colnames(rel) <- fit@pta$vnames$lv.x[[1]]
rel_transpose <- as.data.frame(t(rel))
rel_transpose <- rel_transpose[1:(nrow(rel_transpose)-1),]
### Output table
opts <- options(knitr.kable.NA = "Not provided in case of cross-loadings")
kable(rel, caption="Factor Reliability",digits=2, linesep = '', longtable=T, format="simple")
options(opts)
```  


```{whites, eval=FALSE, echo = eval_code}
## Observed Covariance Matrix
obscov <- inspect(fit, "sampstat")$cov  
corrplot::corrplot(obscov, is.corr = FALSE,
               type = 'lower',
               order = "original",
               col='black', method="number", cl.pos = "n", tl.cex=.50, number.cex=0.50)
```

```{whites, eval=FALSE, echo = eval_code}
## Model-Implied Covariance Matrix
fittedcov <- inspect(fit, what="cov.ov") # Fitted cov
corrplot::corrplot(fittedcov, is.corr = FALSE,
               type = 'lower',
               order = "original",
               col='black', method="number", cl.pos = "n", tl.cex=.50, number.cex=0.50)
```


```{whites, eval=FALSE, echo = eval_code}
## Residual Covariance Matrix
covraw <- lavResiduals(fit,type="raw")$cov
corrplot::corrplot(covraw, is.corr = FALSE,
               type = 'lower',
               order = "original",
               tl.col='black', tl.cex=.50, number.cex=0.50, method="number", cl.cex = 0.5)
```  

```{whites, eval=FALSE, echo = eval_code}
## Standardized Residual Matrix
covstd <- lavResiduals(fit,type="raw")$cov.z
corrplot::corrplot(covstd, is.corr = FALSE,
               type = 'lower',
               order = "original",
               tl.col='black', tl.cex=.50, number.cex=0.50, method="number", cl.cex = 0.5)

```  


```{whites, eval=FALSE, echo = eval_code}
## Residual Correlation Matrix
r <- resid(fit, "cor")$cov # Residuals on cor
corrplot::corrplot(r, is.corr = FALSE,
               type = 'lower',
               order = "original",
               tl.col='black', tl.cex=.50, number.cex=0.50, method="number", cl.cex = 0.5)
```  


```{r, include = FALSE, eval = eval_code}
# Indicator for Modification Indices

# MI for Error Covariances 
mi_corr <- modindices(fit, sort.=TRUE, power=TRUE, high.power = 0.75, na.remove=TRUE, op="~~", maximum.number=10)
mi_corr <- mi_corr[which(mi_corr$lhs %in% fit@pta$vnames$ov[[1]]),]
if (nrow(mi_corr)>0) mi_corr_indic <- TRUE else mi_corr_indic <- FALSE

# MI for Factor Loadings 
mi_fl <- modindices(fit, sort.=TRUE, power=TRUE, high.power = 0.75, na.remove=TRUE, op="=~", delta=0.4, maximum.number=10)
if (nrow(mi_fl)>0) mi_fl_indic <- TRUE else mi_fl_indic <- FALSE

# MI for Factor Covariances
mi_fcov <- modindices(fit, sort.=TRUE, power=TRUE, high.power = 0.75, na.remove=TRUE, op="~~", maximum.number=10)
mi_fcov <- mi_fcov[which(mi_fcov$lhs %in% fit@pta$vnames$lv[[1]]),]
if (nrow(mi_fcov)>0) mi_fcov_indic <- TRUE else mi_fcov_indic <- FALSE
```


```{whites, eval=FALSE, echo = mi_corr_indic}
## Modification Indices for Correlation
mi_corr <- modindices(fit, sort.=TRUE, power=TRUE, high.power = 0.75, 
                      na.remove=TRUE, op="~~", maximum.number=10)
mi_corr <- mi_corr[which(mi_corr$lhs %in% fit@pta$vnames$ov[[1]]),]
mi_corr <- mi_corr[,c(-6,-8)]
rownames(mi_corr) <- NULL
kable(mi_corr,col.names=c("Left","Operator","Right","Modification Index", 
                          "Expected Parameter Change", "Delta", "Power", "Decision"), 
      digits=3, caption="Modification Indices With Respect To Error Covariances", 
      linesep = '', longtable=T, format="simple")
```


```{whites, eval=FALSE, echo = mi_fl_indic}
## Modification Indices for Factor Loadings 
mi_fl <- modindices(fit, sort.=TRUE, power=TRUE, high.power = 0.75, 
                    na.remove=TRUE, op="=~", delta=0.4, maximum.number=10)
mi_fl <- mi_fl[,c(-6,-8)]
rownames(mi_fl) <- NULL
kable(mi_fl,col.names=c("Left","Operator","Right","Modification Index", 
                        "Expected Parameter Change", "Delta", "Power", "Decision"), 
      digits=3, caption="Modification Indices With Respect To Factor Loadings", 
      linesep = '', longtable=T, format="simple")  
```  


```{whites, eval=FALSE, echo = mi_fcov_indic}
# Modification Indices for Factor Covariances 
mi_fcov <- modindices(fit, sort.=TRUE, power=TRUE, high.power = 0.75, 
                      na.remove=TRUE, op="~~", maximum.number=10)
mi_fcov <- mi_fcov[which(mi_fcov$lhs %in% fit@pta$vnames$lv[[1]]),]
mi_fcov <- mi_fcov[,c(-6,-8)]
rownames(mi_fcov) <- NULL
kable(mi_fcov,col.names=c("Left","Operator","Right","Modification Index", 
                                 "Expected Parameter Change", "Delta", "Power", "Decision"), 
             digits=3, caption="Modification Indices With Respect To Factor Covariances", 
             linesep = '', longtable=T, format="simple")
```


```{whites, eval=FALSE, echo = eval_code}
## Path Diagram
semPaths(fit, what="std", intercepts = FALSE)
```

```{r, results="asis", eval = eval_code}
cat("\n# References", fill=TRUE)
```
 

