From 5463c93e0ae2954c95eeee4b42d27fbdf6f30fdb Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 27 Nov 2024 17:43:13 +0100
Subject: [PATCH] `data_summary()` works with `bayestestR::ci()` (#483)

* Draft new `data_summary()` function

* check if we can avoid duplicated code

* pkgdown

* fix

* fixes

* lintr

* add tests

* code style

* desc, news

* fix

* add print method and snapshot test

* add test

* correct english form

* test

* include NA, sort output

* add test

* meaningful code comments

* add test

* Update data_summary.R

* fix
---
 DESCRIPTION                        |  2 +-
 NEWS.md                            |  3 +++
 R/data_summary.R                   | 21 ++++++++++++++++-----
 tests/testthat/test-data_summary.R | 23 +++++++++++++++++++++++
 4 files changed, 43 insertions(+), 6 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index be41e0f6f..b75f96278 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: datawizard
 Title: Easy Data Wrangling and Statistical Transformations
-Version: 0.13.0.14
+Version: 0.13.0.15
 Authors@R: c(
     person("Indrajeet", "Patil", , "patilindrajeet.science@gmail.com", role = "aut",
            comment = c(ORCID = "0000-0003-1995-6531")),
diff --git a/NEWS.md b/NEWS.md
index 15b7f853d..a701ba2b8 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -25,6 +25,9 @@ CHANGES
 * The `replacement` argument in `data_rename()` now supports glue-styled
   tokens  (#563).
 
+* `data_summary()` also accepts the results of `bayestestR::ci()` as summary
+  function (#483).
+
 BUG FIXES
 
 * `describe_distribution()` no longer errors if the sample was too sparse to compute
diff --git a/R/data_summary.R b/R/data_summary.R
index 546c47659..521266d61 100644
--- a/R/data_summary.R
+++ b/R/data_summary.R
@@ -122,7 +122,7 @@ data_summary.data.frame <- function(x, ..., by = NULL, remove_na = FALSE) {
       # bind grouping-variables and values
       summarised_data <- cbind(s[1, by], summarised_data)
       # make sure we have proper column names
-      colnames(summarised_data) <- c(by, vapply(summarise, names, character(1)))
+      colnames(summarised_data) <- c(by, unlist(lapply(summarise, names)))
       summarised_data
     })
     out <- do.call(rbind, out)
@@ -187,18 +187,24 @@ data_summary.grouped_df <- function(x, ..., by = NULL, remove_na = FALSE) {
 
     out <- lapply(seq_along(dots), function(i) {
       new_variable <- .get_new_dots_variable(dots, i, data)
-      stats::setNames(new_variable, names(dots)[i])
+      if (inherits(new_variable, c("bayestestR_ci", "bayestestR_eti"))) {
+        stats::setNames(new_variable, c("CI", "CI_low", "CI_high"))
+      } else {
+        stats::setNames(new_variable, names(dots)[i])
+      }
     })
   }
 
   # check for correct length of output - must be a single value!
-  if (any(lengths(out) != 1)) {
+  # Exception: bayestestR::ci()
+  wrong_length <- !sapply(out, inherits, what = c("bayestestR_ci", "bayestestR_eti")) & lengths(out) != 1 # nolint
+  if (any(wrong_length)) {
     insight::format_error(
       paste0(
         "Each expression must return a single value. Following expression",
-        ifelse(sum(lengths(out) != 1) > 1, "s", " "),
+        ifelse(sum(wrong_length) > 1, "s", " "),
         " returned more than one value: ",
-        text_concatenate(vapply(dots[lengths(out) != 1], insight::safe_deparse, character(1)), enclose = "\"")
+        text_concatenate(vapply(dots[wrong_length], insight::safe_deparse, character(1)), enclose = "\"")
       )
     )
   }
@@ -214,6 +220,11 @@ print.dw_data_summary <- function(x, ...) {
   if (nrow(x) == 0) {
     cat("No matches found.\n")
   } else {
+    if (all(c("CI", "CI_low", "CI_high") %in% colnames(x))) {
+      ci <- insight::format_table(x[c("CI", "CI_low", "CI_high")], ...)
+      x$CI <- x$CI_low <- x$CI_high <- NULL
+      x <- cbind(x, ci)
+    }
     cat(insight::export_table(x, missing = "<NA>", ...))
   }
 }
diff --git a/tests/testthat/test-data_summary.R b/tests/testthat/test-data_summary.R
index c60b142d2..701fc996b 100644
--- a/tests/testthat/test-data_summary.R
+++ b/tests/testthat/test-data_summary.R
@@ -228,3 +228,26 @@ test_that("data_summary, extra functions", {
   out <- data_summary(mtcars, n = n(), by = c("am", "gear"))
   expect_identical(out$n, c(15L, 4L, 8L, 5L))
 })
+
+
+test_that("data_summary, bayestestR::ci", {
+  skip_if_not_installed("bayestesR")
+  data(mtcars)
+  out <- data_summary(
+    mtcars,
+    mean_value = mean(mpg),
+    ci = bayestestR::ci(mpg),
+    by = c("am", "gear")
+  )
+  expect_snapshot(out)
+  expect_error(
+    data_summary(
+      mtcars,
+      mw = mean(mpg),
+      test = bayestestR::ci(mpg),
+      yolo = c(mean(mpg), sd(mpg)),
+      by = c("am", "gear")
+    ),
+    regex = "Each expression"
+  )
+})