Tidy way to get `summary` output per group?

Viewed 137

My code frequently uses tapply and summary as shown below:

data <- tibble(
  year = rep(2018:2021, 3),
  x = runif(length(year))
)

tapply(data$x, data$year, summary)

The output looks like:

$`2018`
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.3914  0.5696  0.7477  0.6668  0.8045  0.8614 

$`2019`
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.1910  0.2863  0.3816  0.4179  0.5313  0.6809 

(etc.)

Is there a way to get such summary-like output in a tibble?

Desired output, using ugly code:

tapply(data$x, data$year, summary)%>% 
  map(~ as.numeric(round(.x, 2))) %>% 
  map_dfr(set_names, names(summary(1))) %>% 
  add_column(year = 2018:2021, .before = 1)
# A tibble: 4 x 7
   year  Min. `1st Qu.` Median  Mean `3rd Qu.`  Max.
  <int> <dbl>     <dbl>  <dbl> <dbl>     <dbl> <dbl>
1  2018  0.39     0.570   0.75  0.67      0.8   0.86
2  2019  0.19     0.290   0.38  0.42      0.53  0.68
3  2020  0.01     0.35    0.7   0.55      0.82  0.93
4  2021  0.06     0.15    0.24  0.32      0.45  0.66

I'm hoping that there is a nice combination of dplyr functions to do that better -- my code to get the desired output is hacky.

Of course, I'm hoping not to have to rewrite base R's summary function, as below:

summarise(`Min` = min(x), `1st Qu.` = quantile(x, 0.25), ...)
3 Answers

Here is a concise tidyverse way.

library(dplyr)
library(purrr)
library(tidyr)

data %>% 
  nest_by(year) %>% 
  mutate(data = map(data, summary)) %>% 
  unnest_wider(data)

# # A tibble: 4 x 7
#    year    Min. `1st Qu.` Median  Mean `3rd Qu.`  Max.
#   <int>   <dbl>     <dbl>  <dbl> <dbl>     <dbl> <dbl>
# 1  2018 0.105       0.256  0.407 0.307     0.407 0.407
# 2  2019 0.0354      0.205  0.375 0.313     0.452 0.529
# 3  2020 0.272       0.467  0.662 0.546     0.684 0.705
# 4  2021 0.00564     0.107  0.208 0.252     0.375 0.542

You can also just convert the table output from your original line. Note that here it converted year to character, so you would probably want to change that back.

library(purrr)

tapply(data$x, data$year, summary) %>% 
  map_dfr(c, .id = "year")

# # A tibble: 4 x 7
#   year     Min. `1st Qu.` Median  Mean `3rd Qu.`  Max.
#   <chr>   <dbl>     <dbl>  <dbl> <dbl>     <dbl> <dbl>
# 1 2018  0.105       0.256  0.407 0.307     0.407 0.407
# 2 2019  0.0354      0.205  0.375 0.313     0.452 0.529
# 3 2020  0.272       0.467  0.662 0.546     0.684 0.705
# 4 2021  0.00564     0.107  0.208 0.252     0.375 0.542

Base R solution

Try with by followed by do.call/rbind.

do.call(rbind, by(data$x, data$year, summary))
#           Min.   1st Qu.    Median      Mean   3rd Qu.      Max.
#2018 0.45126737 0.5437956 0.6363238 0.6343376 0.7258727 0.8154215
#2019 0.70134602 0.7425629 0.7837798 0.8227042 0.8833833 0.9829869
#2020 0.02726706 0.3338530 0.6404389 0.4591294 0.6750606 0.7096822
#2021 0.26667973 0.3242120 0.3817443 0.4953048 0.6096173 0.8374904

This returns a "matrix":

class(do.call(rbind, by(data$x, data$year, summary)))
#[1] "matrix" "array"

To get a "data.frame", coerce the return value after, don't use rbind.data.frame, it will loose the column names.

smry <- do.call(rbind, by(data$x, data$year, summary))
as.data.frame(smry)

dplyr solution.

A dplyr and purrr solution could be the following. Note that it doesn't round, it coerces the return value of map_dfr, which is columns of class "table", to numeric instead.

library(purrr)
library(dplyr)

tapply(data$x, data$year, summary)%>% 
  map_dfr(set_names, names(summary(1))) %>%
  mutate(across(everything(), as.numeric))
## A tibble: 4 x 6
#    Min. `1st Qu.` Median  Mean `3rd Qu.`  Max.
#   <dbl>     <dbl>  <dbl> <dbl>     <dbl> <dbl>
#1 0.451      0.544  0.636 0.634     0.726 0.815
#2 0.701      0.743  0.784 0.823     0.883 0.983
#3 0.0273     0.334  0.640 0.459     0.675 0.710
#4 0.267      0.324  0.382 0.495     0.610 0.837

Another possible tidyverse solution. Same basic idea as Rui's solution above, but a little more verbose since it uses nest() and unnest() before pivoting back to wide data.

library(tidyverse)

data <- tibble(
  year = rep(2018:2021, 3),
  x = runif(length(year))
)

df_summary <- data %>% 
  nest_by(year) %>% 
  mutate(
    summary = map(data, ~list(summary(.x))), 
    df = map(summary, ~data.frame(names = names(.x), values = c(.x))),
  ) %>% 
  unnest(df) %>% 
  select(-data, -summary) %>% 
  pivot_wider(names_from = names, values_from = values)

   year  Min. `1st Qu.` Median  Mean `3rd Qu.`  Max.
  <int> <dbl>     <dbl>  <dbl> <dbl>     <dbl> <dbl>
1  2018 0.204     0.351  0.498 0.538     0.705 0.912
2  2019 0.548     0.673  0.798 0.767     0.877 0.956
3  2020 0.228     0.416  0.604 0.604     0.792 0.980
4  2021 0.240     0.314  0.388 0.357     0.416 0.443
Related