add TEMPLATE FILE (report.default) that one can use to add support fo…

…r new models

DESCRIPTION

@@ -67,6 +67,7 @@ Collate:
     'report.bayesfactor_models.R'
     'report.character.R'
     'report.data.frame.R'
+    'report.default.R'
     'report.factor.R'
     'report.glm.R'
     'report.glmmTMB.R'
@@ -81,6 +82,7 @@ Collate:
     'report_effectsize.R'
     'report_info.R'
     'report_intecept.R'
+    'report_misc.R'
     'report_model.R'
     'report_parameters.R'
     'report_participants.R'
@@ -92,4 +94,5 @@ Collate:
     'report_table.R'
     'startup_message.R'
     'utils_data.R'
+    'utils_error_message.R'
     'utils_grouped_df.R'

NAMESPACE

@@ -241,6 +241,7 @@ export(format_model)
 export(format_text)
 export(is.report)
 export(report)
+export(report_date)
 export(report_effectsize)
 export(report_info)
 export(report_intercept)
@@ -253,6 +254,7 @@ export(report_priors)
 export(report_random)
 export(report_sample)
 export(report_statistics)
+export(report_story)
 export(report_system)
 export(report_table)
 export(report_text)

R/report.R

@@ -68,6 +68,10 @@
 #' \itemize{
 #'   \item \code{\link{as.report}}
 #' }
+#' Template file for supporting new models:
+#' \itemize{
+#'   \item \code{\link{report.default}}
+#' }
 #'
 #' @examples
 #' library(report)
@@ -89,15 +93,6 @@ report <- function(x, ...) {
 
 
 
-#' @export
-report.default <- function(x, ...) {
-  stop("The input you provided is not supported yet by report :(")
-}
-
-
-
-
-
 
 # Generic Methods --------------------------------------------------
 

R/report.data.frame.R

@@ -7,7 +7,7 @@
 #' @param centrality Character vector, indicating the index of centrality (either \code{"mean"} or \code{"median"}).
 #' @param dispersion Show index of dispersion (\link{sd} if \code{centrality = "mean"}, or \link{mad} if \code{centrality = "median"}).
 #' @param range Show range.
-#' @param distribution Show \code{\link[parameters:kurtosis]{kurtosis}} and \code{\link[parameters:skewness]{skewness}}.
+#' @param distribution Show \code{\link[parameters:skewness]{kurtosis}} and \code{\link[parameters:skewness]{skewness}}.
 #' @param n_entries Number of different character entries to show. Can be "all".
 #' @param levels_percentage Show characters entries and factor levels by number or percentage. If "auto", then will be set to number and percentage if the length if n observations larger than 100.
 #' @param missing_percentage Show missing by number (default) or percentage. If "auto", then will be set to number and percentage if the length if n observations larger than 100.

R/report.default.R

@@ -0,0 +1,224 @@
+#' Template to add report support for new objects
+#'
+#' \href{URL}{Template file} to add report support for new objects. Check-out the vignette on \href{https://easystats.github.io/report/articles/new_models.html}{Supporting New Models}.
+#'
+#' @param x Object of class \code{NEW OBJECT}.
+#' @inheritParams report
+#'
+#' @inherit report return seealso
+#'
+#' @examples
+#' library(report)
+#'
+#' # Add a reproducible example instead of the following
+#' model <- lm(Sepal.Length ~ Petal.Length * Species, data = iris)
+#' r <- report(model)
+#' r
+#' summary(r)
+#' as.data.frame(r)
+#' summary(as.data.frame(r))
+#'
+#' @export
+report.default <- function(x, ...) {
+  # You can remove the following line once the functions below are implemented
+  stop(.error_message(x, "report()"))
+
+  text <- report_text(x, ...)
+  table <- report_table(x, ...)
+  as.report(text = text, table = table, ...)
+}
+
+
+# report_effectsize -------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_effectsize.default <- function(x, ...){
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_effectsize()"))
+
+  text <- c("large", "medium", "small")
+  text_short <- c("l", "m", "s")
+
+  as.report_effectsize(text, summary = text_short, ...)
+}
+
+
+# report_table ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_table.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_table()"))
+
+  table <- data.frame(V1 = c(1, 2), V2 = c("A", "B"), V3 = c(42, 7))
+  table_short <- table[c("V1", "V2")]
+
+  as.report_table(table, summary = table_short, ...)
+}
+
+
+# report_statistics ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_statistics.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_statistics()"))
+
+  text <- c("(z = 3, p < .05)", "(z = 1, p > 0.09)")
+  text_short <- c("(z = 3)", "(z = 1)")
+
+  as.report_statistics(text, summary = text_short, ...)
+}
+
+
+# report_parameters ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_parameters.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_parameters()"))
+
+  text <- c("it's great (z = 3, p < .05)", "it's terrible (z = 1, p > 0.09)")
+  text_short <- c("it's great (z = 3)", "it's terrible (z = 1)")
+
+  as.report_parameters(text, summary = text_short, ...)
+}
+
+
+# report_intercept ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_intercept.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_intercept()"))
+
+  text <- "The intercept is at 3 (z = 1, p > 0.09)"
+  text_short <- "The intercept is at 3 (z = 1)"
+
+  as.report_intercept(text, summary = text_short, ...)
+}
+
+
+# report_model ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_model.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_model()"))
+
+  text <- "We fitted a super duper model called the 'easymodel'"
+  text_short <- "We fitted a super duper model"
+
+  as.report_model(text, summary = text_short, ...)
+}
+
+
+# report_random ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_random.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_random()"))
+
+  text <- "The random factors are entered as this and that (formula)"
+  text_short <- "The random factors are entered as this and that"
+
+  as.report_random(text, summary = text_short, ...)
+}
+
+
+# report_priors ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_priors.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_priors()"))
+
+  text <- "Priors were specified like this (formula)"
+  text_short <- "Priors were specified like this"
+
+  as.report_priors(text, summary = text_short, ...)
+}
+
+
+# report_performance ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_performance.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_performance()"))
+
+  text <- "The model is simply awesome (p < 0.0001)"
+  text_short <- "The model is simply awesome"
+
+  as.report_performance(text, summary = text_short, ...)
+}
+
+
+# report_info ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_info.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_info()"))
+
+  text <- "Degrees of freedom were computed using this method, which does that"
+  text_short <- "Degrees of freedom were computed using this method"
+
+  as.report_info(text, summary = text_short, ...)
+}
+
+
+# report_text ------------------------------------------------------------
+
+#' @rdname report.default
+#' @export
+report_text.default <- function(x, ...) {
+  # Delete the whole function if it's NOT applicable to your model / object.
+  # Don't forget to edit the documentation name above ('rdname report.NEWCLASS')
+  # You can remove the following line and fill it with some (working) code :)
+  stop(.error_message(x, "report_text()"))
+
+  text <- paste(
+    report_model(x),
+    report_performance(x),
+    report_parameters(x),
+    report_info(x)
+  )
+  text_short <- paste(
+    report_performance(x),
+    report_parameters(x)
+  )
+
+  as.report_text(text, summary = text_short, ...)
+}

R/report_effectsize.R

@@ -40,11 +40,6 @@ report_effectsize <- function(x, ...) {
 }
 
 
-#' @export
-report_effectsize.default <- function(x, ...) {
-  stop(paste0("report_effectsize() is not available for objects of class ", class(x)))
-}
-
 # METHODS -----------------------------------------------------------------
 
 

R/report_info.R

@@ -41,10 +41,6 @@ report_info <- function(x, ...) {
 }
 
 
-#' @export
-report_info.default <- function(x, ...) {
-  stop(paste0("report_info() is not available for objects of class ", class(x)))
-}
 
 # METHODS -----------------------------------------------------------------
 

R/report_intecept.R

@@ -33,11 +33,6 @@ report_intercept <- function(x, ...) {
 }
 
 
-#' @export
-report_intercept.default <- function(x, ...) {
-  stop(paste0("report_intercept() is not available for objects of class ", class(x)))
-}
-
 # METHODS -----------------------------------------------------------------
 
 

R/report_misc.R

@@ -0,0 +1,32 @@
+#' Miscellaneous reports
+#'
+#'  Why? Because we can.
+#'
+#' @inheritParams report
+#'
+#' @inherit report return seealso
+#'
+#' @examples
+#' library(report)
+#'
+#' report_date()
+#' report_story()
+#'
+#' @export
+report_date <- function(...){
+  date <- Sys.time()
+  text <- format(date, "It's %A, %B  %d of the year %Y, at %l%P %M and %S seconds")
+  text_short <- format(date, "%d/%m/%y - %H:%M:%S")
+  as.report_text(text, summary=text_short)
+}
+
+
+
+#' @rdname report_date
+#' @export
+report_story <- function(...){
+  text <-
+"Did you ever hear the tragedy of Darth Plagueis The Wise? I thought not. It's not a story the Jedi would tell you. It's a Sith legend. Darth Plagueis was a Dark Lord of the Sith, so powerful and so wise he could use the Force to influence the midichlorians to create life... He had such a knowledge of the dark side that he could even keep the ones he cared about from dying. The dark side of the Force is a pathway to many abilities some consider to be unnatural. He became so powerful... the only thing he was afraid of was losing his power, which eventually, of course, he did. Unfortunately, he taught his apprentice everything he knew, then his apprentice killed him in his sleep. Ironic. He could save others from death, but not himself."
+  text_short <- "So this is how liberty dies. With thunderous applause."
+  as.report_text(text, summary=text_short)
+}

R/report_model.R

@@ -40,10 +40,6 @@ report_model <- function(x, table = NULL, ...) {
 }
 
 
-#' @export
-report_model.default <- function(x, ...) {
-  stop(paste0("report_model() is not available for objects of class ", class(x)))
-}
 
 # METHODS -----------------------------------------------------------------
 

R/report_parameters.R

@@ -52,11 +52,6 @@ report_parameters <- function(x, ...) {
 }
 
 
-#' @export
-report_parameters.default <- function(x, ...) {
-  stop(paste0("report_parameters() is not available for objects of class ", class(x)))
-}
-
 # METHODS -----------------------------------------------------------------