How do I build a dplyr summarize statement programmatically? - r

I'm trying to do some dplyr programming and having trouble. I'd like to group_by an arbitrary number of variables (thus, across), and then summarize based on arbitrary length (but all the same length) vectors of:
The column to apply the function to
The function to apply
The name of the new column
So, like in a map or apply statement, I want to execute code that ends up looking like:
data %>%
group_by(group_column) %>%
summarize(new_name_1 = function_1(column_1),
summarize(new_name_2 = function_2(column_2))
Here's an example of what I want and my best shot so far. I know I can use the names argument to clean those up if I use across, but I'm not confident that across is the correct way. Finally, I'll be applying this to fairly large dataframes, so I'd rather not calculate the extra columns.
Desired result
mtcars %>%
group_by(across(c("cyl", "carb"))) %>%
summarise(across(c("disp", "hp"), list(mean = mean, sd = sd))) %>%
select(cyl, carb, disp_mean, hp_sd)
#> `summarise()` regrouping output by 'cyl' (override with `.groups` argument)
#> # A tibble: 9 x 4
#> # Groups: cyl [3]
#> cyl carb disp_mean hp_sd
#> <dbl> <dbl> <dbl> <dbl>
#> 1 4 1 91.4 16.1
#> 2 4 2 117. 24.9
#> 3 6 1 242. 3.54
#> 4 6 4 164. 7.51
#> 5 6 6 145 NA
#> 6 8 2 346. 14.4
#> 7 8 3 276. 0
#> 8 8 4 406. 21.7
#> 9 8 8 301 NA
What I get
mtcars %>%
group_by(across(c("cyl", "carb"))) %>%
summarise(across(c("disp", "hp"), list(mean = mean, sd = sd)))
#> `summarise()` regrouping output by 'cyl' (override with `.groups` argument)
#> # A tibble: 9 x 6
#> # Groups: cyl [3]
#> cyl carb disp_mean disp_sd hp_mean hp_sd
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 4 1 91.4 21.4 77.4 16.1
#> 2 4 2 117. 27.1 87 24.9
#> 3 6 1 242. 23.3 108. 3.54
#> 4 6 4 164. 4.39 116. 7.51
#> 5 6 6 145 NA 175 NA
#> 6 8 2 346. 43.4 162. 14.4
#> 7 8 3 276. 0 180 0
#> 8 8 4 406. 57.8 234 21.7
#> 9 8 8 301 NA 335 NA

With different functions on different columns, an option is to use collap from collapse
library(collapse)
collap(mtcars, ~ cyl + carb, custom = list(fmean = 4, fsd = 5))
-output
cyl disp hp carb
1 4 91.38 16.133815 1
2 4 116.60 24.859606 2
3 6 241.50 3.535534 1
4 6 163.80 7.505553 4
5 6 145.00 NA 6
6 8 345.50 14.433757 2
7 8 275.80 0.000000 3
8 8 405.50 21.725561 4
9 8 301.00 NA 8
Or the index can be dynamically generated with match
collap(mtcars, ~ cyl + carb, custom = list(fmean =
match('disp', names(mtcars)), fsd = match('hp', names(mtcars))))
With tidyverse, an option is to loop over the column names of interest and the functions in map2 and do a join later
library(dplyr)
library(purrr)
library(stringr)
map2(c("disp", "hp"), c("mean", "sd"), ~
mtcars %>%
group_by(across(c('cyl', 'carb'))) %>%
summarise(across(all_of(.x), match.fun(.y),
.names = str_c("{.col}_", .y)), .groups = 'drop')) %>%
reduce(inner_join)
-output
# A tibble: 9 x 4
cyl carb disp_mean hp_sd
<dbl> <dbl> <dbl> <dbl>
1 4 1 91.4 16.1
2 4 2 117. 24.9
3 6 1 242. 3.54
4 6 4 164. 7.51
5 6 6 145 NA
6 8 2 346. 14.4
7 8 3 276. 0
8 8 4 406. 21.7
9 8 8 301 NA

I have a package on github {dplyover}
which can help with this kind of tasks. In this case we could use over2 to
loop over two character vectors simultaniously. The first vector contains the
variable names as string, which is why we have to wrap .x in sym() when
applying a function to it. The second vector contains the function names,
which we use as .y in a do.call. over2 creates the desired names automatically.
library(dplyr)
library(dplyover) # https://github.com/TimTeaFan/dplyover
mtcars %>%
group_by(across(c("cyl", "carb"))) %>%
summarise(over2(c("disp", "hp"),
c("mean", "sd"),
~ do.call(.y, list(sym(.x)))
))
#> `summarise()` has grouped output by 'cyl'. You can override using the `.groups` argument.
#> # A tibble: 9 x 4
#> # Groups: cyl [3]
#> cyl carb disp_mean hp_sd
#> <dbl> <dbl> <dbl> <dbl>
#> 1 4 1 91.4 16.1
#> 2 4 2 117. 24.9
#> 3 6 1 242. 3.54
#> 4 6 4 164. 7.51
#> 5 6 6 145 NA
#> 6 8 2 346. 14.4
#> 7 8 3 276. 0
#> 8 8 4 406. 21.7
#> 9 8 8 301 NA
An alternative way building on the same logic is to use purrr::map2. However,
here we have to put some effort into creating vectors with the desired names.
library(purrr)
# setup vectors and names
myfuns <- c("mean", "sd")
myvars <- c("disp", "hp") %>%
set_names(., paste(., myfuns, sep = "_"))
mtcars %>%
group_by(across(c("cyl", "carb"))) %>%
summarise(map2(myvars,
myfuns,
~ do.call(.y, list(sym(.x)))
) %>% bind_cols()
)
#> `summarise()` has grouped output by 'cyl'. You can override using the `.groups` argument.
#> # A tibble: 9 x 4
#> # Groups: cyl [3]
#> cyl carb disp_mean hp_sd
#> <dbl> <dbl> <dbl> <dbl>
#> 1 4 1 91.4 16.1
#> 2 4 2 117. 24.9
#> 3 6 1 242. 3.54
#> 4 6 4 164. 7.51
#> 5 6 6 145 NA
#> 6 8 2 346. 14.4
#> 7 8 3 276. 0
#> 8 8 4 406. 21.7
#> 9 8 8 301 NA
Created on 2021-08-20 by the reprex package (v2.0.1)

Related

Number of rows per group along with other summary functions

I am trying to find number of rows and some other function after grouping by two different factors. Surprisingly, n() is not working. Is there any work around?
library(dplyr)
#> Warning: package 'dplyr' was built under R version 3.6.3
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
mtcars %>% group_by(cyl, am) %>%
summarise(across(c(disp, mpg), list(m = min, a = mean)))
#> `summarise()` regrouping output by 'cyl' (override with `.groups` argument)
#> # A tibble: 6 x 6
#> # Groups: cyl [3]
#> cyl am disp_m disp_a mpg_m mpg_a
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 4 0 120. 136. 21.5 22.9
#> 2 4 1 71.1 93.6 21.4 28.1
#> 3 6 0 168. 205. 17.8 19.1
#> 4 6 1 145 155 19.7 20.6
#> 5 8 0 276. 358. 10.4 15.0
#> 6 8 1 301 326 15 15.4
mtcars %>% group_by(cyl, am) %>%
summarise(across(c(disp, mpg), list(m = min, n = n())))
#> Error: Problem with `summarise()` input `..1`.
#> x Can't convert an integer vector to function
#> i Input `..1` is `across(c(disp, mpg), list(m = min, n = n()))`.
#> i The error occurred in group 1: cyl = 4, am = 0.
Created on 2020-11-27 by the reprex package (v0.3.0)
You could use length:
mtcars %>%
group_by(cyl, am) %>%
summarise(across(c(disp, mpg), list(m = min, n = length)))
#`summarise()` regrouping output by 'cyl' (override with `.groups` argument)
## A tibble: 6 x 6
#> # Groups: cyl [3]
#> cyl am disp_m disp_n mpg_m mpg_n
#> <dbl> <dbl> <dbl> <int> <dbl> <int>
#> 1 4 0 120. 3 21.5 3
#> 2 4 1 71.1 8 21.4 8
#> 3 6 0 168. 4 17.8 4
#> 4 6 1 145 3 19.7 3
#> 5 8 0 276. 12 10.4 12
#> 6 8 1 301 2 15 2
We can do
library(dplyr)
mtcars %>%
group_by(cyl, am) %>%
summarise(across(c(disp, mpg), list(m = ~ min(.), n = ~n())), .groups = 'drop')
# A tibble: 6 x 6
cyl am disp_m disp_n mpg_m mpg_n
<dbl> <dbl> <dbl> <int> <dbl> <int>
1 4 0 120. 3 21.5 3
2 4 1 71.1 8 21.4 8
3 6 0 168. 4 17.8 4
4 6 1 145 3 19.7 3
5 8 0 276. 12 10.4 12
6 8 1 301 2 15 2

working with columns containing `call` class objects in `tidyr::unnest`

I have a package that creates calls containing stats details that can then be displayed in plots.
Here is a simple use case:
# setup
set.seed(123)
library(statsExpressions)
library(tidyverse)
# two-sample t-test results in an expression
stats_exp <- bf_ttest(mtcars, am, wt)
# class of object
class(stats_exp)
#> [1] "call"
# using the expression to display details in a plot
ggplot(mtcars, aes(as.factor(am), wt)) + geom_boxplot() +
labs(subtitle = stats_exp)
Now let's say I wanted to do the same kind of visualizations for all levels of a grouping variable. In this case, I will need to create and save the call for each level.
I can successfully do so using tidyr, which can save the call objects in a list column:
# doing this across groups
(df <- mtcars %>%
group_nest(cyl) %>%
mutate(stats_exp = data %>% map(., ~bf_ttest(., am, wt))))
# A tibble: 3 x 3
cyl data stats_exp
<dbl> <list> <list>
1 4 <tibble [11 × 10]> <language>
2 6 <tibble [7 × 10]> <language>
3 8 <tibble [14 × 10]> <language>
# did it work? yes!
df$stats_exp[[1]]
#> atop(displaystyle(NULL), expr = paste("In favor of null: ", "log"["e"],
#> "(BF"["01"], ") = ", "-1.58", ", ", italic("r")["Cauchy"]^"JZS",
#> " = ", "0.71"))
The problem arises when I try to unnest it, which I would like to do since I will need to do some other operations on this dataframe somewhere downstream in my workflow:
# unnest
tidyr::unnest(data = df, cols = c(stats_exp, data))
#> Error: Input must be list of vectors
How can I avoid this error?
I'm not sure what you intend to do to the stats_exp after you've manipulated the other data but this could a potential solution:
set.seed(123)
library(statsExpressions)
library(tidyverse)
stats_exp <- bf_ttest(mtcars, am, wt)
df <- mtcars %>%
group_nest(cyl) %>%
mutate(stats_exp = map(data, ~ bf_ttest(.x, am, wt)),
stats_chr = map(stats_exp, ~ paste0(deparse(.x), collapse = " ")))
df %>%
select(stats_chr) %>%
unnest(cols = stats_chr)
#> # A tibble: 3 x 1
#> stats_chr
#> <chr>
#> 1 "atop(displaystyle(NULL), expr = paste(\"In favor of null: \", \"log\"[\"e\"]~
#> 2 "atop(displaystyle(NULL), expr = paste(\"In favor of null: \", \"log\"[\"e\"]~
#> 3 "atop(displaystyle(NULL), expr = paste(\"In favor of null: \", \"log\"[\"e\"]~
Created on 2020-02-25 by the reprex package (v0.3.0)
Based on a solution provided on Twitter (h/t #dvaughan32). unnest won't fail if stats_exp is not included in cols argument:
library(tidyverse)
library(statsExpressions)
# doing this across groups
df <- mtcars %>%
group_nest(cyl) %>%
mutate(stats_exp = data %>% map(., ~bf_ttest(., am, wt)))
# alternative
tidyr::unnest(data = df, cols = c(data))
#> # A tibble: 32 x 12
#> cyl mpg disp hp drat wt qsec vs am gear carb stats_exp
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <list>
#> 1 4 22.8 108 93 3.85 2.32 18.6 1 1 4 1 <language>
#> 2 4 24.4 147. 62 3.69 3.19 20 1 0 4 2 <language>
#> 3 4 22.8 141. 95 3.92 3.15 22.9 1 0 4 2 <language>
#> 4 4 32.4 78.7 66 4.08 2.2 19.5 1 1 4 1 <language>
#> 5 4 30.4 75.7 52 4.93 1.62 18.5 1 1 4 2 <language>
#> 6 4 33.9 71.1 65 4.22 1.84 19.9 1 1 4 1 <language>
#> 7 4 21.5 120. 97 3.7 2.46 20.0 1 0 3 1 <language>
#> 8 4 27.3 79 66 4.08 1.94 18.9 1 1 4 1 <language>
#> 9 4 26 120. 91 4.43 2.14 16.7 0 1 5 2 <language>
#> 10 4 30.4 95.1 113 3.77 1.51 16.9 1 1 5 2 <language>
#> # … with 22 more rows
Created on 2020-02-27 by the reprex package (v0.3.0)

Purrr and Rlang - mapping functions with quasiquotation

If I have a function defined using rlang, how I can use purrr::map to use it with several variables ?
Suppose I have a function defined as:
mean_by <- function(data, by, var) {
data %>%
group_by({{ by }}) %>%
summarise(avg = mean({{ var }}, na.rm = TRUE))
}
Which computes group means,
Preferably using a purrr::map solution, how could I apply this function for several "by" variables but a single "var" in a data frame?
You need the !!! operator or using group_by_at
library(tidyverse)
mean_by <- function(data, by, var) {
data %>%
group_by_at(by) %>%
summarise(avg = {{var}} %>% mean(na.rm =TRUE))
}
mtcars %>%
mean_by(by = vars(mpg,cyl),hp)
#> # A tibble: 27 x 3
#> # Groups: mpg [25]
#> mpg cyl avg
#> <dbl> <dbl> <dbl>
#> 1 10.4 8 210
#> 2 13.3 8 245
#> 3 14.3 8 245
#> 4 14.7 8 230
#> 5 15 8 335
#> 6 15.2 8 165
#> 7 15.5 8 150
#> 8 15.8 8 264
#> 9 16.4 8 180
#> 10 17.3 8 180
#> # … with 17 more rows
# or
mean_by <- function(data, by, var) {
data %>%
group_by(!!!by) %>%
summarise(avg = {{var}} %>% mean(na.rm =TRUE))
}
mtcars %>%
mean_by(by = vars(cyl,disp),hp)
#> # A tibble: 27 x 3
#> # Groups: cyl [3]
#> cyl disp avg
#> <dbl> <dbl> <dbl>
#> 1 4 71.1 65
#> 2 4 75.7 52
#> 3 4 78.7 66
#> 4 4 79 66
#> 5 4 95.1 113
#> 6 4 108 93
#> 7 4 120. 97
#> 8 4 120. 91
#> 9 4 121 109
#> 10 4 141. 95
#> # … with 17 more rows
Created on 2020-01-07 by the reprex package (v0.3.0)
A good alternative is to "pass the dots".
The first argument will be the single variable you want to summarise, and use ... to pass all (if any) grouping variables you want.
This way you have a cleaner syntax for your function and you avoid including the vars function.
library(tidyverse)
mean_by <- function(data, var, ...) {
data %>%
group_by(...) %>%
summarise(avg = {{var}} %>% mean(na.rm =TRUE))
}
mtcars %>%
mean_by(hp, cyl, disp)
#> # A tibble: 27 x 3
#> # Groups: cyl [3]
#> cyl disp avg
#> <dbl> <dbl> <dbl>
#> 1 4 71.1 65
#> 2 4 75.7 52
#> 3 4 78.7 66
#> 4 4 79 66
#> 5 4 95.1 113
#> 6 4 108 93
#> 7 4 120. 97
#> 8 4 120. 91
#> 9 4 121 109
#> 10 4 141. 95
#> # ... with 17 more rows
mtcars %>%
mean_by(hp)
#> # A tibble: 1 x 1
#> avg
#> <dbl>
#> 1 147.
Created on 2020-01-08 by the reprex package (v0.3.0)

Why aggregate and summarise gives answers in different order?

If I calculate something using aggregate function or using summarise in dplyr package why those gives answers different order?
Example:
a <- aggregate(hp~mpg+cyl+gear, mtcars, FUN = sum)
gives me
mpg cyl gear hp
1 21.5 4 3 97
2 18.1 6 3 105
3 21.4 6 3 110
4 10.4 8 3 420
5 13.3 8 3 245
and
b <- mtcars %>%
group_by(mpg, cyl, gear) %>%
summarise(hp = sum(hp))
gives me
mpg cyl gear hp
<dbl> <dbl> <dbl> <dbl>
1 10.4 8 3 420
2 13.3 8 3 245
3 14.3 8 3 245
4 14.7 8 3 230
5 15 8 5 335
Why order is not the same?
As mentioned by #zx8754, tidyverse operations will re-order the rows. No guarantee that you will get a certain row order.
https://github.com/tidyverse/dplyr/issues/2192#issuecomment-281655703
Looking a bit closely, I see that aggregate sorted by gear, cyl, then mpg.
So the following tidyverse code will provide the same row order as aggregate(hp~mpg+cyl+gear, mtcars, FUN = sum) :
library(tidyverse)
mtcars %>% group_by(gear, cyl, mpg) %>% summarise(hp = sum(hp)) %>% head()
#> # A tibble: 6 x 4
#> # Groups: gear, cyl [3]
#> gear cyl mpg hp
#> <dbl> <dbl> <dbl> <dbl>
#> 1 3 4 21.5 97
#> 2 3 6 18.1 105
#> 3 3 6 21.4 110
#> 4 3 8 10.4 420
#> 5 3 8 13.3 245
#> 6 3 8 14.3 245
Created on 2019-02-27 by the reprex package (v0.2.1)
and to get the same row order as mtcars %>% group_by(mpg, cyl, gear) %>% summarise(hp = sum(hp)):
library(tidyverse)
aggregate(hp~gear+cyl+mpg, mtcars, FUN = sum) %>% head()
#> gear cyl mpg hp
#> 1 3 8 10.4 420
#> 2 3 8 13.3 245
#> 3 3 8 14.3 245
#> 4 3 8 14.7 230
#> 5 5 8 15.0 335
#> 6 3 8 15.2 330
Created on 2019-02-27 by the reprex package (v0.2.1)

Add baseline/grand total with group_by() in dplyr

When I've grouped my data by certain attributes, I want to add a "grand total" line that gives a baseline of comparison. Let's group mtcars by cylinders and carburetors, for example:
by_cyl_carb <- mtcars %>%
group_by(cyl, carb) %>%
summarize(median_mpg = median(mpg),
avg_mpg = mean(mpg),
count = n())
...yields these results:
> by_cyl_carb
# A tibble: 9 x 5
# Groups: cyl [?]
cyl carb median_mpg avg_mpg count
<dbl> <dbl> <dbl> <dbl> <int>
1 4 1 27.3 27.6 5
2 4 2 25.2 25.9 6
3 6 1 19.8 19.8 2
4 6 4 20.1 19.8 4
5 6 6 19.7 19.7 1
6 8 2 17.1 17.2 4
7 8 3 16.4 16.3 3
8 8 4 13.8 13.2 6
9 8 8 15 15 1
What is the code I need to make it provide a baseline or grand total that would sum (or mean or median) over all of the data? The desired data would be something like this:
cyl carb median_mpg avg_mpg count
<chr> <chr> <dbl> <dbl> <int>
1 4 1 27.3 27.6 5
2 4 2 25.2 25.9 6
3 6 1 19.8 19.8 2
4 6 4 20.1 19.8 4
5 6 6 19.7 19.7 1
6 8 2 17.1 17.2 4
7 8 3 16.4 16.3 3
8 8 4 13.8 13.2 6
9 8 8 15 15 1
10 ttl ttl 19.2 20.1 32
A twist on this would be able to manipulate the output so that the sub-grouped data would be rolled up. For example:
11 ttl 1 13.8 13.2 6
12 ttl 2 15 15 1
13 ttl 3 19.3 20.4 32
14 ... etc ...
The real-life example I am using this for is median sale price of homes by geography by year. Hence I want to report out the median sale price for each geography-year I'm interested in, but I want a baseline comparison for each year regardless of geography.
Edit: Solved with two solutions
#camille referenced this link, which solved the problem, as well as #MKR offering a solution. Here is one code that might work:
by_cyl_carb <- mtcars %>%
mutate_at(vars(c(cyl,carb)), funs(as.character(.))) %>%
bind_rows(mutate(., cyl = "All cylinders")) %>%
bind_rows(mutate(., carb = "All carburetors")) %>%
group_by(cyl, carb) %>%
summarize(median_mpg = median(mpg),
avg_mpg = mean(mpg),
count = n())
> by_cyl_carb
# A tibble: 19 x 5
# Groups: cyl [?]
cyl carb median_mpg avg_mpg count
<chr> <chr> <dbl> <dbl> <int>
1 4 1 27.3 27.6 5
2 4 2 25.2 25.9 6
3 4 All carburetors 26 26.7 11
4 6 1 19.8 19.8 2
5 6 4 20.1 19.8 4
6 6 6 19.7 19.7 1
7 6 All carburetors 19.7 19.7 7
8 8 2 17.1 17.2 4
9 8 3 16.4 16.3 3
10 8 4 13.8 13.2 6
11 8 8 15 15 1
12 8 All carburetors 15.2 15.1 14
13 All cylinders 1 22.8 25.3 7
14 All cylinders 2 22.1 22.4 10
15 All cylinders 3 16.4 16.3 3
16 All cylinders 4 15.2 15.8 10
17 All cylinders 6 19.7 19.7 1
18 All cylinders 8 15 15 1
19 All cylinders All carburetors 19.2 20.1 32
A solution using dplyr::bind_rows and mutate_at can be achieved as:
library(tidyverse)
mtcars %>%
group_by(cyl, carb) %>%
summarize(median_mpg = median(mpg),
avg_mpg = mean(mpg),
count = n()) %>%
ungroup() %>%
mutate_at(vars(cyl:carb), funs(as.character(.))) %>%
bind_rows(summarise(cyl = "ttl", carb = "ttl", mtcars, median_mpg = median(mpg),
avg_mpg = mean(mpg),
count = n()))
# # A tibble: 10 x 5
# cyl carb median_mpg avg_mpg count
# <chr> <chr> <dbl> <dbl> <int>
# 1 4 1 27.3 27.6 5
# 2 4 2 25.2 25.9 6
# 3 6 1 19.8 19.8 2
# 4 6 4 20.1 19.8 4
# 5 6 6 19.7 19.7 1
# 6 8 2 17.1 17.2 4
# 7 8 3 16.4 16.3 3
# 8 8 4 13.8 13.2 6
# 9 8 8 15.0 15.0 1
#10 ttl ttl 19.2 20.1 32

Resources