objects of class [Date] are not supported by report_table() #373

easystats · Jun 14, 2023 · f199606 · f199606
1 parent bc4f0dd
commit f199606
Show file tree

Hide file tree

Showing 5 changed files with 50 additions and 3 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: report
 Title: Automated Reporting of Results and Statistical Models
-Version: 0.5.7.7
+Version: 0.5.7.8
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",

diff --git a/NAMESPACE b/NAMESPACE
@@ -27,6 +27,7 @@ S3method(print,report_table)
 S3method(print,report_text)
 S3method(print_html,report_sample)
 S3method(print_md,report_sample)
+S3method(report,Date)
 S3method(report,MixMod)
 S3method(report,anova)
 S3method(report,aov)
@@ -115,6 +116,7 @@ S3method(report_model,merMod)
 S3method(report_model,stanreg)
 S3method(report_model,survreg)
 S3method(report_model,zeroinfl)
+S3method(report_parameters,Date)
 S3method(report_parameters,MixMod)
 S3method(report_parameters,anova)
 S3method(report_parameters,aov)
@@ -163,6 +165,7 @@ S3method(report_random,glmmTMB)
 S3method(report_random,lme)
 S3method(report_random,merMod)
 S3method(report_random,stanreg)
+S3method(report_statistics,Date)
 S3method(report_statistics,MixMod)
 S3method(report_statistics,anova)
 S3method(report_statistics,aov)
@@ -186,6 +189,7 @@ S3method(report_statistics,stanreg)
 S3method(report_statistics,survreg)
 S3method(report_statistics,test_performance)
 S3method(report_statistics,zeroinfl)
+S3method(report_table,Date)
 S3method(report_table,MixMod)
 S3method(report_table,anova)
 S3method(report_table,aov)
@@ -214,6 +218,7 @@ S3method(report_table,stanreg)
 S3method(report_table,survreg)
 S3method(report_table,test_performance)
 S3method(report_table,zeroinfl)
+S3method(report_text,Date)
 S3method(report_text,MixMod)
 S3method(report_text,anova)
 S3method(report_text,aov)

diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,8 @@
 
 Minor changes
 
+* `report` now supports variables of class `Date`, treating them like factors.
+
 * `report_sample` now reports the weighted number of observations when data
   is both grouped an weighted.
 

diff --git a/R/report.factor.R b/R/report.factor.R
@@ -1,16 +1,20 @@
 #' @rdname report.data.frame
 #' @export
 report.factor <- function(x, levels_percentage = "auto", ...) {
+  if (!is.factor(x)) {
+    x <- as.factor(x)
+  }
   table <- report_table(x, levels_percentage = levels_percentage, ...)
   text <- report_text(x, levels_percentage = levels_percentage, ...)
 
   as.report(text, table = table, ...)
 }
 
-
 #' @export
 report.logical <- report.factor
 
+#' @export
+report.Date <- report.factor
 
 
 # report_table ------------------------------------------------------------
@@ -19,6 +23,9 @@ report.logical <- report.factor
 
 #' @export
 report_table.factor <- function(x, levels_percentage = "auto", ...) {
+  if (!is.factor(x)) {
+    x <- as.factor(x)
+  }
   levels_percentage <- .report_dataframe_percentage(x, levels_percentage)
 
   if (length(x[is.na(x)]) != 0) {
@@ -42,12 +49,19 @@ report_table.factor <- function(x, levels_percentage = "auto", ...) {
 #' @export
 report_table.logical <- report_table.factor
 
+#' @export
+report_table.Date <- report_table.factor
+
+
 # report_parameters -------------------------------------------------------
 
 
 
 #' @export
 report_parameters.factor <- function(x, table = NULL, levels_percentage = "auto", ...) {
+  if (!is.factor(x)) {
+    x <- as.factor(x)
+  }
   # Get table
   if (is.null(table)) {
     table <- report_table(x, levels_percentage = levels_percentage, ...)
@@ -78,14 +92,20 @@ report_parameters.factor <- function(x, table = NULL, levels_percentage = "auto"
   as.report_parameters(text_full, summary = text, ...)
 }
 
-
 #' @export
 report_parameters.logical <- report_parameters.factor
 
+#' @export
+report_parameters.Date <- report_parameters.factor
+
+
 # report_text -------------------------------------------------------------
 
 #' @export
 report_text.factor <- function(x, table = NULL, levels_percentage = "auto", ...) {
+  if (!is.factor(x)) {
+    x <- as.factor(x)
+  }
   if (!is.null(list(...)$varname)) {
     name <- list(...)$varname
   } else if (is.null(names(x))) {
@@ -116,13 +136,19 @@ report_text.factor <- function(x, table = NULL, levels_percentage = "auto", ...)
 #' @export
 report_text.logical <- report_text.factor
 
+#' @export
+report_text.Date <- report_text.factor
+
 
 
 # report_statistics -------------------------------------------------------
 
 
 #' @export
 report_statistics.factor <- function(x, table = NULL, levels_percentage = "auto", ...) {
+  if (!is.factor(x)) {
+    x <- as.factor(x)
+  }
   if (is.null(table)) {
     table <- report_table(x, levels_percentage = levels_percentage, ...)
   }
@@ -151,3 +177,6 @@ report_statistics.factor <- function(x, table = NULL, levels_percentage = "auto"
 
   as.report_statistics(paste0(text_full, collapse = "; "), summary = paste0(text, collapse = "; "))
 }
+
+#' @export
+report_statistics.Date <- report_statistics.factor
diff --git a/tests/testthat/test-report.data.frame.R b/tests/testthat/test-report.data.frame.R
@@ -40,6 +40,17 @@ test_that("report.factor", {
   expect_equal(nrow(as.data.frame(r)), 4, tolerance = 0)
 })
 
+test_that("report.Date", {
+  set.seed(123)
+  x <- sample(seq(as.Date("1999/01/01"), as.Date("1999/01/05"), by = "day"), 30, replace = TRUE)
+  r <- report(x)
+  expect_equal(
+    as.character(r),
+    "x: 5 levels, namely 1999-01-01 (n = 6, 20.00%), 1999-01-02 (n = 6, 20.00%), 1999-01-03 (n = 9, 30.00%), 1999-01-04 (n = 4, 13.33%) and 1999-01-05 (n = 5, 16.67%)",
+    ignore_attr = TRUE
+  )
+})
+
 test_that("report.data.frame", {
   skip_if_not_installed("dplyr")