From 6d22f2197586f6ad2e2acd90bdbabc829847ff9f Mon Sep 17 00:00:00 2001 From: DominiqueMakowski Date: Sun, 17 Jan 2021 21:42:54 +0800 Subject: [PATCH] initialize report.test_performance --- DESCRIPTION | 1 + NAMESPACE | 5 + R/report.test_performance.R | 228 +++++++++++++++++++++++++++++++++ R/report_table.R | 15 ++- man/report.test_performance.Rd | 88 +++++++++++++ tests/spelling.R | 25 +--- 6 files changed, 339 insertions(+), 23 deletions(-) create mode 100644 R/report.test_performance.R create mode 100644 man/report.test_performance.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 74935af3..b6ca80c7 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NAMESPACE b/NAMESPACE index 52547fc0..220ab835 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/report.test_performance.R b/R/report.test_performance.R new file mode 100644 index 00000000..6b18f9db --- /dev/null +++ b/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) +} \ No newline at end of file diff --git a/R/report_table.R b/R/report_table.R index dbf8d288..51d86560 100644 --- a/R/report_table.R +++ b/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 } diff --git a/man/report.test_performance.Rd b/man/report.test_performance.Rd new file mode 100644 index 00000000..a1a02aa3 --- /dev/null +++ b/man/report.test_performance.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/report.test_performance.R +\name{report.test_performance} +\alias{report.test_performance} +\alias{report_table.test_performance} +\alias{report_statistics.test_performance} +\alias{report_parameters.test_performance} +\alias{report_text.test_performance} +\title{Reporting models comparison} +\usage{ +\method{report}{test_performance}(x, ...) + +\method{report_table}{test_performance}(x, ...) + +\method{report_statistics}{test_performance}(x, table = NULL, ...) + +\method{report_parameters}{test_performance}(x, table = NULL, ...) + +\method{report_text}{test_performance}(x, table = NULL, ...) +} +\arguments{ +\item{x}{Object of class \code{NEW OBJECT}.} + +\item{...}{Arguments passed to or from other methods.} + +\item{table}{Provide the output of \code{report_table()} to avoid its re-computation.} +} +\value{ +A list-object of class \code{report}, which contains further list-objects +with a short and long description of the model summary, as well as a short +and long table of parameters and fit indices. +} +\description{ +Create reports for model comparison as obtained by the \code{\link[performance:compare_performance]{performance::compare_performance()}} function in the \code{performance} package. +} +\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) +} + +} +\seealso{ +Specific components of reports (especially for stats models): +\itemize{ + \item \code{\link{report_table}} + \item \code{\link{report_parameters}} + \item \code{\link{report_statistics}} + \item \code{\link{report_effectsize}} + \item \code{\link{report_model}} + \item \code{\link{report_priors}} + \item \code{\link{report_random}} + \item \code{\link{report_performance}} + \item \code{\link{report_info}} + \item \code{\link{report_text}} +} +Other types of reports: +\itemize{ + \item \code{\link{report_system}} + \item \code{\link{report_packages}} + \item \code{\link{report_participants}} + \item \code{\link{report_sample}} + \item \code{\link{report_date}} +} +Methods: +\itemize{ + \item \code{\link{as.report}} +} +Template file for supporting new models: +\itemize{ + \item \code{\link{report.default}} +} +} diff --git a/tests/spelling.R b/tests/spelling.R index 90ee796b..5f40a291 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,23 +1,8 @@ if (requireNamespace("spelling", quietly = TRUE)) { - # Fails for now (see https://github.com/ropensci/spelling/issues/58) - - # spelling::spell_check_test( - # vignettes = TRUE, - # error = FALSE, - # skip_on_cran = TRUE - # ) - - - # files <- list.files("./", recursive = TRUE) - # files <- files[files != "README.md"] - # - # for(i in files){ - # if(stringr::str_detect(i, ".png|.jpg|.svg|.ai")) { - # next - # } - # # print(i) - # spelling::spell_check_files(i) - # } - + spelling::spell_check_test( + vignettes = TRUE, + error = FALSE, + skip_on_cran = TRUE + ) }