report_performance for lavaan

DESCRIPTION

@@ -41,6 +41,7 @@ Suggests:
 	dplyr,
 	httr,
 	knitr,
+	lavaan,
 	lme4,
 	logspline,
 	rstanarm,
@@ -73,6 +74,7 @@ Collate:
     'report.factor.R'
     'report.glm.R'
     'report.glmmTMB.R'
+    'report.lavaan.R'
     'report.lme.R'
     'report.lme4.R'
     'report.numeric.R'

NAMESPACE

@@ -33,6 +33,7 @@ S3method(report,glm)
 S3method(report,glmmTMB)
 S3method(report,grouped_df)
 S3method(report,htest)
+S3method(report,lavaan)
 S3method(report,lm)
 S3method(report,lme)
 S3method(report,logical)
@@ -119,6 +120,7 @@ S3method(report_performance,MixMod)
 S3method(report_performance,default)
 S3method(report_performance,glm)
 S3method(report_performance,glmmTMB)
+S3method(report_performance,lavaan)
 S3method(report_performance,lm)
 S3method(report_performance,lme)
 S3method(report_performance,merMod)
@@ -166,6 +168,7 @@ S3method(report_table,glm)
 S3method(report_table,glmmTMB)
 S3method(report_table,grouped_df)
 S3method(report_table,htest)
+S3method(report_table,lavaan)
 S3method(report_table,lm)
 S3method(report_table,lme)
 S3method(report_table,logical)

R/report.R

@@ -10,6 +10,7 @@
 #' % \item{\link[=report.lmerMod]{Mixed models} (\code{glmer, lmer, glmmTMB, ...})}
 #'  \item{\link[=report.stanreg]{Bayesian models} (\code{stanreg, brms...})}
 #'  \item{\link[=report.bayesfactor_models]{Bayes factors} (from \code{bayestestR})}
+#'  % \item{\link[=report.lavaan]{Structural Equation Models (SEM)} (from \code{lavaan})}
 #' }
 #'
 #' @param x The R object that you want to report (see list of of supported objects above).

R/report.data.frame.R

@@ -1,4 +1,4 @@
-#' Data frame Report
+#' Reports of Data
 #'
 #' Create a report of a data frame.
 #'

R/report.htest.R

@@ -1,4 +1,4 @@
-#' Report of h-tests (Correlation, t-test...)
+#' Reports of h-tests (Correlation, t-test...)
 #'
 #' Create a report of an h-test object (\code{t.test()}, \code{cor.test()}).
 #'

R/report.lavaan.R

@@ -0,0 +1,108 @@
+#' Reports of Structural Equation Models (SEM)
+#'
+#' Create a report for \code{lavaan} objects.
+#'
+#' @param x Object of class \code{lavaan}.
+#' @inheritParams report
+#' @inheritParams report.htest
+#' @inheritParams report.lm
+#'
+#' @inherit report return seealso
+#'
+#' @examples
+#' library(report)
+#'
+#' # Structural Equation Models (SEM)
+#' if (require("lavaan")) {
+#'   structure <- " ind60 =~ x1 + x2 + x3
+#'                  dem60 =~ y1 + y2 + y3
+#'                  dem60 ~ ind60 "
+#'   model <- lavaan::sem(structure, data = PoliticalDemocracy)
+#'   report(model)
+#' }
+#' @export
+report.lavaan <- function(x, ...) {
+  print("Support for lavaan not implemented yet :(")
+}
+
+
+
+
+
+#' @export
+report_table.lavaan <- function(x, ...) {
+
+  parameters <- parameters::model_parameters(x, ...)
+  table <- as.data.frame(parameters)
+  table$Parameter <- paste(table$To, table$Operator, table$From)
+  table <- data_remove(table, c("To", "Operator", "From"))
+  table <- data_reorder(table, "Parameter")
+
+  # Combine -----
+  # Add performance
+  performance <- performance::model_performance(x, ...)
+  table <- .combine_tables_performance(table, performance)
+  table <- table[!tolower(table$Parameter) %in% c("baseline", "baseline_df", "baseline_p"), ]
+
+  # Clean -----
+  # Rename some columns
+
+  # Shorten ----
+  table_full <- data_remove(table, "SE")
+  table <- data_remove(table_full, data_findcols(table_full, ends_with = c("_CI_low|_CI_high")))
+  table <- table[!table$Parameter %in% c("AIC", "BIC",
+                                         "RMSEA"), ]
+
+  # Prepare -----
+  out <- as.report_table(table_full,
+                         summary = table,
+                         performance = performance,
+                         parameters = parameters,
+                         ...)
+  # Add attributes from params table
+  for (att in c("ci")) {
+    attr(out, att) <- attributes(parameters)[[att]]
+  }
+
+  out
+}
+
+
+
+
+
+
+
+#' @rdname report.lavaan
+#' @export
+report_performance.lavaan <- function(x, table=NULL, ...) {
+  if (!is.null(table) | is.null(attributes(table)$performance)) {
+    table <- report_table(x, ...)
+  }
+  performance <- attributes(table)$performance
+
+  # Chi2
+  text_chi2 <- ""
+  if(all(c("p_Chi2", "Chi2", "Chi2_df") %in% names(performance))){
+    sig <- "significantly"
+    if(performance$p_Chi2 > .05){
+      sig <- "not significantly"
+    }
+    text_chi2 <- paste0(text_chi2,
+                   "The model is ",
+                   sig,
+                   " different from a baseline model (Chi2(",
+                   insight::format_value(performance$Chi2_df, protect_integers = TRUE),
+                   ") = ",
+                   insight::format_value(performance$Chi2),
+                   ", ",
+                   parameters::format_p(performance$p_Chi2), ").")
+  }
+
+  perf_table <- effectsize::interpret(performance)
+  text_full <- text_paste(text_chi2, .text_performance_lavaan(perf_table), sep = " ")
+  text <- text_paste(text_chi2, .text_performance_lavaan(perf_table[perf_table$Name %in% c("RMSEA", "CFI", "SRMR"),]), sep = " ")
+
+
+  as.report_performance(text_full, summary = text)
+}

R/report.lm.R

@@ -1,4 +1,4 @@
-#' (General) Linear Models Report
+#' Reports of (General) Linear Models
 #'
 #' Create a report for (general) linear models.
 #'

R/report.stanreg.R

@@ -1,4 +1,4 @@
-#' Bayesian Models Report
+#' Reports of Bayesian Models
 #'
 #' Create a report Bayesian models. The description of the parameters follows the
 #' Sequential Effect eXistence and sIgnificance Testing framework (see \link[bayestestR:sexit]{SEXIT documentation}).

R/report_performance.R

@@ -27,6 +27,15 @@
 #'   model <- stan_glm(Sepal.Length ~ Species, data = iris, refresh=0, iter=600)
 #'   report_performance(model)
 #' }
+#'
+#' # Structural Equation Models (SEM)
+#' if (require("lavaan")) {
+#'   structure <- " ind60 =~ x1 + x2 + x3
+#'                  dem60 =~ y1 + y2 + y3
+#'                  dem60 ~ ind60 "
+#'   model <- lavaan::sem(structure, data = PoliticalDemocracy)
+#'   report_performance(model)
+#' }
 #' @export
 report_performance <- function(x, table = NULL, ...) {
   UseMethod("report_performance")
@@ -228,3 +237,41 @@ print.report_performance <- function(x, ...) {
   list(text_full=text_full, text=text)
 
 }
+
+
+#' @keywords internal
+.text_performance_lavaan <- function(perf_table, ...){
+  perf_table$Text <- paste0(
+    perf_table$Name,
+    " (",
+    substring(insight::format_value(perf_table$Value), 2),
+    ifelse(perf_table$Value > perf_table$Threshold, " > ", " < "),
+    substring(insight::format_value(perf_table$Threshold), 2),
+    ")"
+  )
+
+  # Satisfactory
+  if(length(perf_table[perf_table$Interpretation == "satisfactory", "Text"]) >= 1){
+    text_satisfactory <- paste0(
+      "The ",
+      report::format_text(perf_table[perf_table$Interpretation == "satisfactory", "Text"]),
+      ifelse(length(perf_table[perf_table$Interpretation == "satisfactory", "Text"]) > 1, " suggest", " suggests"),
+      " a satisfactory fit.")
+  } else{
+    text_satisfactory <- ""
+  }
+
+  # Poor
+  if(length(perf_table[perf_table$Interpretation == "poor", "Text"]) >= 1){
+    text_poor <- paste0(
+      "The ",
+      report::format_text(perf_table[perf_table$Interpretation == "poor", "Text"]),
+      ifelse(length(perf_table[perf_table$Interpretation == "poor", "Text"]) > 1, " suggest", " suggests"),
+      " a poor fit.")
+  } else{
+    text_poor <- ""
+  }
+
+  text <- text_paste(text_satisfactory, text_poor, sep = " ")
+  text
+}

R/report_table.R

@@ -42,6 +42,16 @@
 #'   model <- stan_glm(Sepal.Length ~ Species, data = iris, refresh=0, iter=600)
 #'   report_table(model, effectsize_method="basic")
 #' }
+#'
+#' # Structural Equation Models (SEM)
+#' if (require("lavaan")) {
+#'   structure <- " ind60 =~ x1 + x2 + x3
+#'                  dem60 =~ y1 + y2 + y3
+#'                  dem60 ~ ind60 "
+#'   model <- lavaan::sem(structure, data = PoliticalDemocracy)
+#'   report_table(model)
+#' }
+#'
 #' @export
 report_table <- function(x, ...) {
   UseMethod("report_table")

R/utils_combine_tables.R

@@ -42,6 +42,8 @@
   perf_names[perf_names == "R2_marginal"] <- "R2 (marginal)"
 
 
+
+
   # add performance
   perf_vertical <- data.frame(
     "Parameter" = perf_names,
@@ -53,7 +55,7 @@
   perf_vertical <- perf_vertical[!is.na(perf_vertical$Fit), ]
 
   # Name parameter column
-  name_parameter <- names(parameters)[names(parameters) %in% c("Parameter", "Link")][1]
+  name_parameter <- names(parameters)[names(parameters) %in% c("Parameter", "Link", "To")][1]
   names(perf_vertical)[1] <- name_parameter
 
   # Merge