initialize report.test_performance

DESCRIPTION

@@ -82,6 +82,7 @@ Collate:
     'report.sessionInfo.R'
     'report.stanreg.R'
     'report.survreg.R'
+    'report.test_performance.R'
     'report.zeroinfl.R'
     'report_effectsize.R'
     'report_info.R'

NAMESPACE

@@ -46,6 +46,7 @@ S3method(report,numeric)
 S3method(report,sessionInfo)
 S3method(report,stanreg)
 S3method(report,survreg)
+S3method(report,test_performance)
 S3method(report,zeroinfl)
 S3method(report_effectsize,MixMod)
 S3method(report_effectsize,anova)
@@ -120,6 +121,7 @@ S3method(report_parameters,numeric)
 S3method(report_parameters,sessionInfo)
 S3method(report_parameters,stanreg)
 S3method(report_parameters,survreg)
+S3method(report_parameters,test_performance)
 S3method(report_parameters,zeroinfl)
 S3method(report_performance,MixMod)
 S3method(report_performance,default)
@@ -159,6 +161,7 @@ S3method(report_statistics,merMod)
 S3method(report_statistics,numeric)
 S3method(report_statistics,stanreg)
 S3method(report_statistics,survreg)
+S3method(report_statistics,test_performance)
 S3method(report_statistics,zeroinfl)
 S3method(report_table,MixMod)
 S3method(report_table,anova)
@@ -184,6 +187,7 @@ S3method(report_table,numeric)
 S3method(report_table,sessionInfo)
 S3method(report_table,stanreg)
 S3method(report_table,survreg)
+S3method(report_table,test_performance)
 S3method(report_table,zeroinfl)
 S3method(report_text,MixMod)
 S3method(report_text,anova)
@@ -208,6 +212,7 @@ S3method(report_text,numeric)
 S3method(report_text,sessionInfo)
 S3method(report_text,stanreg)
 S3method(report_text,survreg)
+S3method(report_text,test_performance)
 S3method(report_text,zeroinfl)
 S3method(summary,report_effectsize)
 S3method(summary,report_info)

R/report.test_performance.R

@@ -0,0 +1,228 @@
+#' Reporting models comparison
+#'
+#' Create reports for model comparison as obtained by the \code{\link[performance:compare_performance]{performance::compare_performance()}} function in the \code{performance} package.
+#'
+#' @param x Object of class \code{NEW OBJECT}.
+#' @inheritParams report
+#' @inheritParams report.lm
+#'
+#' @inherit report return seealso
+#'
+#' @examples
+#' library(report)
+#'
+#' m1 <- lm(Sepal.Length ~ Petal.Length * Species, data = iris)
+#' m2 <- lm(Sepal.Length ~ Petal.Length + Species, data = iris)
+#' m3 <- lm(Sepal.Length ~ Petal.Length, data = iris)
+#'
+#' if(require("performance")){
+#'   x <- performance::test_performance(m1, m2, m3)
+#'   # r <- report(x)
+#'   # r
+#'   # summary(r)
+#'   # as.data.frame(r)
+#'   # summary(as.data.frame(r))
+#'
+#'   # Specific reports
+#'   report_table(x)
+#'   report_statistics(x)
+#'   report_parameters(x)
+#' }
+#'
+#' @export
+report.test_performance <- function(x, ...) {
+  table <- report_table(x, table = table, ...)
+  text <- report_text(x, ...)
+  as.report(text = text, table = table, ...)
+}
+
+# report_table ------------------------------------------------------------
+
+#' @rdname report.test_performance
+#' @export
+report_table.test_performance <- function(x, ...) {
+  as.report_table(x, summary = x, as_is = TRUE)
+}
+
+
+# report_statistics ------------------------------------------------------------
+
+#' @rdname report.test_performance
+#' @export
+report_statistics.test_performance <- function(x, table = NULL, ...) {
+  if (is.null(table)) {
+    table <- report_table(x, ...)
+  }
+
+  text <- text_short <- ""
+  if("BF" %in% names(table)){
+    val <-
+    text <- text_paste(text, insight::format_bf(na.omit(table$BF)))
+  }
+
+  if("Omega2" %in% names(table)){
+    val <- na.omit(table$Omega2)
+    text2 <- paste0("Omega2 = ",
+                    insight::format_value(na.omit(table$Omega2)),
+                    ", ",
+                    insight::format_p(na.omit(table$p_Omega2)))
+    text <- text_paste(text, text2, sep="; ")
+  }
+
+  if("LR" %in% names(table)){
+    val <- na.omit(table$LR)
+    text2 <- paste0("LR = ",
+                    insight::format_value(na.omit(table$LR)),
+                    ", ",
+                    insight::format_p(na.omit(table$p_LR)))
+    text <- text_paste(text, text2, sep="; ")
+  }
+
+  as.report_statistics(text, summary = text_short, table = table)
+}
+
+# report_parameters ------------------------------------------------------------
+
+#' @rdname report.test_performance
+#' @export
+report_parameters.test_performance <- report_parameters.compare_performance
+
+
+# report_performance ------------------------------------------------------------
+
+# #' @rdname report.test_performance
+# #' @export
+# report_performance.compare_performance <- function(x, table = NULL, ...) {
+#   stats <- report_statistics(x, table = table, ...)
+#   table <- attributes(stats)$table
+#
+#   models <- table$Model
+#
+#   text <- ""
+#   text_short <- ""
+#   # if("p" %in% names(table)){
+#   #   p <- effectsize::interpret_p(table$p)[-1]
+#   #   text <- paste0(
+#   #     models[-1],
+#   #     " (",
+#   #     stats[-1],
+#   #     ") has a ",
+#   #     p,
+#   #     "ly different explanatory power from ",
+#   #     models[1],
+#   #     " (",
+#   #     stats[1],
+#   #     ", ",
+#   #     insight::format_p(table$p)[-1],
+#   #     ")")
+#   #   text_short <- paste0(
+#   #     models[-1],
+#   #     " (",
+#   #     summary(stats)[-1],
+#   #     ") has a ",
+#   #     p,
+#   #     "ly different explanatory power from ",
+#   #     models[1],
+#   #     " (",
+#   #     summary(stats)[1],
+#   #     ", ",
+#   #     insight::format_p(table$p)[-1],
+#   #     ")")
+#   # }
+#   #
+#   # if("BF" %in% names(table)){
+#   #   bfs <- effectsize::interpret_bf(table$BF, include_value = TRUE, exact = FALSE)[-1]
+#   #   text_bf <- paste0(bfs,
+#   #               " the hypothesis that ",
+#   #               models[-1],
+#   #               " has a stronger predictive power than ",
+#   #               models[1])
+#   #   text <- text_paste(text, text_bf, sep=", and there is ")
+#   #   text_short <- text_paste(text_short, text_bf, sep=", and there is ")
+#   # }
+#
+#   as.report_performance(text, summary = text_short, table = table)
+# }
+
+
+
+
+# report_text ------------------------------------------------------------
+
+#' @rdname report.test_performance
+#' @export
+report_text.test_performance <- function(x, table=NULL, ...) {
+
+  stats <- report_statistics(x, table = table)
+  table <- attributes(stats)$table
+
+  # Get indices
+  models <- table$Model
+  text <- text_concatenate(paste0(models, " (", stats, ")"))
+  text_short <- text_concatenate(paste0(models, " (", summary(stats), ")"))
+
+  # Add intro sentence
+  text_start <- paste0("We compared ",
+                      insight::format_number(nrow(table)),
+                      " ",
+                      ifelse(length(unique(table$Type)) == 1, format_model(unique(table$Type)), "model"),
+                      "s")
+  text <- paste0(text_start, "; ", text, ".")
+  text_short <- paste0(text_start, "; ", text_short, ".")
+
+
+  # if("p" %in% names(table)){
+  #   p <- effectsize::interpret_p(table$p)[-1]
+  #   text <- paste0(
+  #     p,
+  #     "ly different from ",
+  #     models[-1],
+  #     " (",
+  #     stats[-1],
+  #     ", ",
+  #     insight::format_p(table$p)[-1],
+  #     ")")
+  #   text_short <- paste0(
+  #     p,
+  #     "ly different from ",
+  #     models[-1],
+  #     " (",
+  #     summary(stats)[-1],
+  #     ", ",
+  #     insight::format_p(table$p)[-1],
+  #     ")")
+  # }
+
+  # text <- paste0(
+  #   "Regarding the explanatory power, ",
+  #   models[1],
+  #   " (",
+  #   stats[1],
+  #   ") is ",
+  #   text_concatenate(text))
+  # text_short <- paste0(
+  #   "Regarding the explanatory power, ",
+  #   models[1],
+  #   " (",
+  #   summary(stats)[1],
+  #   ") is ",
+  #   text_concatenate(text_short))
+
+
+  # if("BF" %in% names(table)){
+  #   bfs <- effectsize::interpret_bf(table$BF, include_value = TRUE, exact = FALSE)[-1]
+  #   t <- paste0(bfs,
+  #               " the superiority of ",
+  #               models[-1],
+  #               " compared to ",
+  #               models[1])
+  #   text_bf <- paste0(
+  #     "Regarding the predictive power, there is ",
+  #     text_concatenate(t))
+  #
+  #   text <- text_paste(text, text_bf, sep = ". ")
+  #   text_short <- text_paste(text_short, text_bf, sep = ". ")
+  # }
+
+  as.report_text(text, summary = text_short)
+}

R/report_table.R

@@ -68,12 +68,21 @@ as.report_table <- function(x, ...) {
 }
 
 #' @export
-as.report_table.default <- function(x, summary = NULL, ...) {
-  class(x) <- unique(c("report_table", class(x)))
+as.report_table.default <- function(x, summary = NULL, as_is = FALSE, ...) {
+  if(as_is) {
+    class(x) <- unique(c(class(x)[1], "report_table", tail(class(x), -1)))
+  } else {
+    class(x) <- unique(c("report_table", class(x)))
+  }
+
   attributes(x) <- c(attributes(x), list(...))
 
   if (!is.null(summary)) {
-    class(summary) <- unique(c("report_table", class(summary)))
+    if(as_is) {
+      class(summary) <- unique(c(class(summary)[1], "report_table", tail(class(summary), -1)))
+    } else {
+      class(summary) <- unique(c("report_table", class(summary)))
+    }
     attr(x, "summary") <- summary
   }