Standard grouped summary

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: dplyr
 Title: A Grammar of Data Manipulation
-Version: 1.1.4.9000
+Version: 1.1.4.9001
 Authors@R: c(
     person("Hadley", "Wickham", , "hadley@posit.co", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-4757-117X")),

NAMESPACE

@@ -431,6 +431,7 @@ export(src_mysql)
 export(src_postgres)
 export(src_sqlite)
 export(src_tbls)
+export(standard_summary)
 export(starts_with)
 export(summarise)
 export(summarise_)
@@ -492,6 +493,8 @@ importFrom(methods,setOldClass)
 importFrom(pillar,glimpse)
 importFrom(pillar,tbl_sum)
 importFrom(pillar,type_sum)
+importFrom(stats,quantile)
+importFrom(stats,sd)
 importFrom(stats,setNames)
 importFrom(stats,update)
 importFrom(tibble,add_row)

R/standard_summary.R

@@ -0,0 +1,50 @@
+#' Standard Summary
+#'
+#' This function calculates standard summary statistics for specified variables in a data frame.
+#'
+#' @param df A data frame.
+#' @param vars A character vector specifying the numeric variables for which summary statistics should be calculated.
+#' @param functions A list of functions to be applied to each variable. The default functions include mean, standard deviation, minimum, 10th percentile, 25th percentile, median, 75th percentile, 90th percentile, maximum, count, and count of missing values.
+#'
+#' @return A data frame containing the calculated summary statistics.
+#'
+#' @examples
+#' df <- data.frame(
+#'   groups = c("a","a","a","b","c"),
+#'   var1 = c(1, 2, 3, 4, 5),
+#'   var2 = c(6, 7, NA, 9, 10)
+#' )
+#'
+#' # Calculate standard summary statistics for var1 and var2
+#' summary <- df %>% group_by(groups) %>% standard_summary(c("var1", "var2"))
+#' print(summary)
+#'
+#' @importFrom stats sd quantile
+#'
+#' @export
+standard_summary <- function(df, vars, functions = list(
+  sum = ~sum(.x, na.rm = TRUE)
+  mean = ~mean(.x, na.rm = TRUE),
+  sd = ~sd(.x, na.rm = TRUE),
+  min = ~min(.x, na.rm = TRUE),
+  q10 = ~quantile(.x, 0.1, na.rm = TRUE),
+  q25 = ~quantile(.x, 0.25, na.rm = TRUE),
+  med = ~quantile(.x, 0.5, na.rm = TRUE),
+  q75 = ~quantile(.x, 0.75, na.rm = TRUE),
+  q90 = ~quantile(.x, 0.90, na.rm = TRUE),
+  max = ~max(.x, na.rm = TRUE),
+  n = ~n(),
+  nmiss = ~length(which(is.na(.x))))
+) {
+  gg <- as.character(groups(df))
+  summary_res <- df %>%
+    select(all_of(vars)) %>%
+    summarise(across(.cols = c(!!vars), .fns = functions, .names = "{.col}xx_xx{.fn}")) %>%
+    ungroup() %>%
+    pivot_longer(cols = contains("xx_xx")) %>%
+    mutate(value = as.numeric(value)) %>%
+    separate(name, into = c("VARIABLE", "STAT"), sep = "xx_xx") %>%
+    pivot_wider(id_cols = c(gg, "VARIABLE"), values_from = value, names_from = STAT) %>%
+    as.data.frame()
+  return(summary_res)
+}

tests/testthat/test-standard-summary.R

@@ -0,0 +1,26 @@
+test_that("standard summary returns correct results", {
+  # Create a test data frame
+  df <- data.frame(
+   groups = c("a","a","a","b","c"),
+   var1 = c(1, 2, 3, 4, 5),
+   var2 = c(6, 7, NA, 9, 10)
+  )
+
+  # Calculate standard summary statistics for var1 and var2
+  result <- starwars %>%
+    filter(!is.na(sex)) %>%
+    group_by(sex) %>%
+    standard_summary(vars=c("height", "mass","birth_year"))
+
+  # Check if the result is a data frame
+  expect_true(is.data.frame(result))
+
+# Check if the result has the correct number of rows and columns
+  expect_equal(nrow(result), 12)
+  expect_equal(df_n_col(result), 13)
+
+  # Check if the result contains the correct summary statistics
+  expect_equal(result[1,"min"], 150)
+  expect_equal(result[2, "med"] , 55)
+  expect_equal(result[7,"nmiss"],3)
+})