Manual bootstrapping for confidence intervals using tidyverse only - r

Question

I have a grouped dataset and I am interested in summarising a column of counts (number of ___). To calculate the standard error for the summary, I want to bootstrap within groups and calculate the standard deviation of medians. I am struggling to figure out how to manually code this (resampling with replacement, and not functions like boot()), without using for loops (i.e., I am hoping for a purely tidyverse solution). If there is a way other than using *apply(), that would be preferred. Wrapping the whole process into a function would be great---either to be used in pipeline with, say, summarise(), or as a standalone function that can be applied to the grouped data.
An ad hoc dataset can be mtcars which I have grouped by gear. I am now interested in summarising the hp column using median and also obtaining confidence intervals for the same. I have already attempted a bunch of solutions suggested by slightly related threads on SO, like replicate()+across(), map()/pmap(), etc. but couldn't get them to work for my specific case.
library(tidyverse)
data <- mtcars %>%
select(gear, hp) %>%
group_by(gear)
> data
# A tibble: 32 x 2
# Groups: gear [3]
gear hp
<dbl> <dbl>
1 4 110
2 4 110
3 4 93
4 3 110
5 3 175
6 3 105
7 3 245
8 4 62
9 4 95
10 4 123
# ... with 22 more rows
I am hoping for a way to integrate the bootstrap results with the simple summarisation as another column (SEs per group):
data2 <- data %>%
summarise(hp = median(hp))
While it may not make much sense to summarise horsepower by number of gears, and the distribution of hp might not be a typical Poisson, I think the coding solution for this example will apply to my specific case nonetheless.
EDIT 1
The solution need not be a clean and robust function. It can be just the lines of code required to obtain the bootstrapped SE value in each group for this specific case. The desired output is just the data2 object, where hp is the column of medians and hpse is the column of SEs.
data2 <- data %>%
summarise(hp = median(hp),
### hpse = workingcode()
)
If not possible to do it directly this way inside the summarise() call, it must at least be possible to later join the values to data2.
Related threads
Using boot()
How to perform a bootstrap and find 95% confidence interval for the median of a dataset
Stratified Bootstrapping in R with >25 strata
Bootsrapping a statistic in a nested data column and retrieve results in tidy format
Bootstrapping a vector of results, by group in R
Using *apply()
Bootstrap a large data set
Using for loop
How to perform a bootstrap and find 95% confidence interval for the median of a dataset
Others
Creating bootstrap samples and storing sampled data in different names

Answer 1

First we can make a bootstrap function:
boot_fn = function(x, fn = median, B = 1000) {
1:B %>%
# For each iteration, generate a sample of x with replacement
map(~ x[sample(1:length(x), replace = TRUE)]) %>%
# Obtain the fn estimate for each bootstrap sample
map_dbl(fn) %>%
# Obtain the standard error
sd()
}
Note how I gave the parameter fn a default value of median, which gives you the opportunity to pass any numeric function you wish into boot_fn().
Now we can use the function as you originally asked:
mtcars %>%
group_by(gear) %>%
summarise(
hp_median = median(hp),
se = boot_fn(hp, fn = median)
)
# A tibble: 3 x 3
gear hp_median se
<dbl> <dbl> <dbl>
1 3 180 13.2
2 4 94 15.2
3 5 175 70.3
The reason this works is because our data is grouped. For each group, a new value of x is sent to boot_fn(). In this case, three different values of x were passed, each being the hp values corresponding to each different value of gear.
This is easy to confirm if we just add a cat() statement in our function:
boot_fn = function(x, fn = median, B = 1000, verbose = FALSE) {
if (verbose) cat("Hello, x is ", x, "\n")
1:B %>%
# For each iteration, generate a sample of x with replacement
map(~ x[sample(1:length(x), replace = TRUE)]) %>%
# Obtain the fn estimate for each bootstrap sample
map_dbl(fn) %>%
# Obtain the standard error
sd()
}
data %>%
summarise(
hp_median = median(hp),
se = boot_fn(hp, fn = median, verbose = TRUE)
)
Output:
Hello, x is 110 175 105 245 180 180 180 205 215 230 97 150 150 245 175
Hello, x is 110 110 93 62 95 123 123 66 52 65 66 109
Hello, x is 91 113 264 175 335
# A tibble: 3 x 3
gear hp_median se
<dbl> <dbl> <dbl>
1 3 180 13.5
2 4 94 14.9
3 5 175 69.6
This function may break down when used on real-world data (due to things like NAs), but this is a good start.

Answer 2

An alternative to #kybazzi's solution that fits in the pipeline workflow is this:
boot_se <- function(x, fn = median, B = 100){
replicate(B,
do.call("fn", list(sample(x, n(), replace = T))),
simplify = F) %>%
unlist() %>%
sd()
}
It seems to be slower at times:
boot_fn = function(x, fn = median, B = 100) {
1:B %>%
# For each iteration, generate a sample of x with replacement
map(~ x[sample(1:length(x), replace = TRUE)]) %>%
# Obtain the fn estimate for each bootstrap sample
map_dbl(fn) %>%
# Obtain the standard error
sd()
}
data1 <- mtcars %>%
select(gear, hp) %>%
group_by(gear)
data2 <- data %>%
summarise(hpmed = median(hp),
hpse = boot_se(hp))
data3 <- data %>%
summarise(hpmed = median(hp),
hpse = boot_fn(hp))
#######################################
library(microbenchmark)
microbenchmark((data %>%
summarise(hpmed = median(hp),
hpse = boot_fn(hp))),
(data %>%
summarise(hpmed = median(hp),
hpse = boot_se(hp))))
# Output:
Unit: milliseconds
expr min lq
(data %>% summarise(hpmed = median(hp), hpse = boot_fn(hp))) 14.5737 15.63690
(data %>% summarise(hpmed = median(hp), hpse = boot_se(hp))) 20.6675 21.64715
mean median uq max neval
22.23120 16.78140 25.85675 91.4154 100
29.15338 22.68525 32.01430 87.6299 100
#######################################
microbenchmark(data2, data3, times = 1000)
# Output:
Unit: nanoseconds
expr min lq mean median uq max neval
data2 0 100.0 95.986 101 101 3501 1000
data3 0 1.5 92.318 101 101 2700 1000