report_statistics.compare_performance

NAMESPACE

@@ -102,6 +102,7 @@ S3method(report_parameters,anova)
 S3method(report_parameters,aov)
 S3method(report_parameters,aovlist)
 S3method(report_parameters,character)
+S3method(report_parameters,compare_performance)
 S3method(report_parameters,data.frame)
 S3method(report_parameters,default)
 S3method(report_parameters,factor)
@@ -119,6 +120,7 @@ S3method(report_parameters,stanreg)
 S3method(report_parameters,survreg)
 S3method(report_parameters,zeroinfl)
 S3method(report_performance,MixMod)
+S3method(report_performance,compare_performance)
 S3method(report_performance,default)
 S3method(report_performance,glm)
 S3method(report_performance,glmmTMB)
@@ -142,6 +144,7 @@ S3method(report_statistics,anova)
 S3method(report_statistics,aov)
 S3method(report_statistics,aovlist)
 S3method(report_statistics,character)
+S3method(report_statistics,compare_performance)
 S3method(report_statistics,data.frame)
 S3method(report_statistics,default)
 S3method(report_statistics,factor)
@@ -188,6 +191,7 @@ S3method(report_text,aovlist)
 S3method(report_text,bayesfactor_inclusion)
 S3method(report_text,bayesfactor_models)
 S3method(report_text,character)
+S3method(report_text,compare_performance)
 S3method(report_text,data.frame)
 S3method(report_text,default)
 S3method(report_text,factor)

R/report.compare_performance.R

@@ -4,6 +4,7 @@
 #'
 #' @param x Object of class \code{NEW OBJECT}.
 #' @inheritParams report
+#' @inheritParams report.lm
 #'
 #' @inherit report return seealso
 #'
@@ -21,18 +22,116 @@
 #'   # summary(r)
 #'   # as.data.frame(r)
 #'   # summary(as.data.frame(r))
+#'
+#'   # Specific reports
+#'   report_table(x)
+#'   report_statistics(x)
+#'   report_parameters(x)
 #' }
 #'
 #' @export
 report.compare_performance <- function(x, ...) {
-  print("Support for compare_performance not fully implemented yet :(")
+  text <- report_text(x, ...)
+  table <- report_table(x, ...)
+  as.report(text = text, table = table, ...)
 }
 
+# report_table ------------------------------------------------------------
 
 #' @rdname report.compare_performance
 #' @export
 report_table.compare_performance <- function(x, ...) {
   table <- x
-  table_short <- x
+  table_short <- x[!names(x) %in% c("Type", "Sigma")]
   as.report_table(table, summary = table_short)
+}
+
+
+# report_statistics ------------------------------------------------------------
+
+#' @rdname report.compare_performance
+#' @export
+report_statistics.compare_performance <- function(x, table = NULL, ...) {
+  if (is.null(table)) {
+    table <- report_table(x, ...)
+  }
+
+  text <- text_short <- ""
+  if("R2" %in% names(table)){
+    text <- text_paste(text, paste0("R2 = ", insight::format_value(table$R2)))
+    if("R2_adjusted" %in% names(table)){
+      text <- text_paste(text, paste0("adj. R2 = ", insight::format_value(table$R2_adjusted)))
+      text_short <- text_paste(text_short, paste0("adj. R2 = ", insight::format_value(table$R2_adjusted)))
+    } else{
+      text_short <- text_paste(text, paste0("R2 = ", insight::format_value(table$R2)))
+    }
+  }
+  if("AIC" %in% names(table)){
+    text <- text_paste(text, paste0("AIC = ", insight::format_value(table$AIC)))
+  }
+  if("BIC" %in% names(table)){
+    text <- text_paste(text, paste0("BIC = ", insight::format_value(table$BIC)))
+    text_short <- text_paste(text_short, paste0("BIC = ", insight::format_value(table$BIC)))
+  }
+  if("WAIC" %in% names(table)){
+    text <- text_paste(text, paste0("WAIC = ", insight::format_value(table$WAIC)))
+    text_short <- text_paste(text_short, paste0("WAIC = ", insight::format_value(table$WAIC)))
+  }
+  if("RMSE" %in% names(table)){
+    text <- text_paste(text, paste0("RMSE = ", insight::format_value(table$RMSE)))
+  }
+  if("Sigma" %in% names(table)){
+    text <- text_paste(text, paste0("Sigma = ", insight::format_value(table$Sigma)))
+  }
+
+  as.report_statistics(text, summary = text_short, table = table)
+}
+
+# report_parameters ------------------------------------------------------------
+
+#' @rdname report.compare_performance
+#' @export
+report_parameters.compare_performance <- function(x, table = NULL, ...) {
+  stats <- report_statistics(x, table = table, ...)
+  table <- attributes(stats)$table
+
+  text <- paste0(table$Model, " (", stats, ")")
+  text_short <- paste0(table$Model, " (", summary(stats), ")")
+
+  as.report_parameters(text, summary = text_short, table = table)
+}
+
+
+# report_performance ------------------------------------------------------------
+
+#' @rdname report.compare_performance
+#' @export
+report_performance.compare_performance <- function(x, table = NULL, ...) {
+  stats <- report_statistics(x, table = table, ...)
+  table <- attributes(stats)$table
+
+  models <- table$Model
+  if("BF" %in% names(table)){
+    bfs <- effectsize::interpret_bf(table$BF, include_value = TRUE)[-1]
+    text <- paste0(
+    "Compared to ",
+    models[1],
+    ", "
+    )
+  }
+
+  as.report_performance(text, summary = text, table = table)
+}
+
+
+
+
+# report_text ------------------------------------------------------------
+
+#' @rdname report.compare_performance
+#' @export
+report_text.compare_performance <- function(x, ...) {
+  text <- "Something"
+  text_short <- "Something"
+  as.report_text(text, summary = text_short)
 }

R/report.lavaan.R

@@ -20,7 +20,11 @@
 #'   model <- lavaan::sem(structure, data = PoliticalDemocracy)
 #'   r <- report(model)
 #'   r
+#'   # summary(r)
+#'   # as.data.frame(r)
+#'   # summary(as.data.frame(r))
 #'
+#'   # Specific reports
 #'   report_table(model)
 #'   report_performance(model)
 #' }