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 = "", ...)) } } 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" + ) +})