r: sampling within groups, matching subgroup sizes

I have a very unbalanced dataset, containing multiple groups, each divided into to two types of observations.
Here's a synthetic example of the structure (actual data contains hundreds of groups and millions of observations):

df <- data.frame(
  group = c(1, 1, 1, 1, 1,  1, 1,    2, 2, 2, 2, 2, 2,  2, 2, 2),
  type  = c(0, 0, 0, 0, 0,  1, 1,    0, 0, 0, 0, 0, 0,  1, 1, 1),
  value = c(1, 2, 3, 4, 5,  6, 7,    1, 2, 3, 4, 5, 6,  7, 8, 9)
)

I need to compare the standard deviation of each type, within each group. Something like that:

df %>% 
  group_by(group, type) %>%
  ## something is missing here...
  summarise(n    = n(), 
            mean = mean(value))

However, the number of observation of each type is unbalanced, and this can bias the comparison.

I thought to reduce the number of "type 0" observation by way of sampling them, to match the number of "type 1" observation for each group.
I found some suggestions to use slice_sample() but couldn't get it to work with this situation of group-type matching...

How can I sample from each pool of group+type0 observations, matching the size of each corresponding group+type1 pool?

You can simply run filter instead of slice_sample like below

df %>%
    filter(
        row_number() %in% c(sample(which(!type), sum(type)), which(type == 1)),
        .by = group
    )

which gives, for example

   group type value
1      1    0     3
2      1    0     5
3      1    1     6
4      1    1     7
5      2    0     1
6      2    0     2
7      2    0     4
8      2    1     7
9      2    1     8
10     2    1     9

You can try this code:

df %>% 
  group_by(group) %>% 
  tidyr::nest() %>% 
  mutate(data = lapply(data, function(i) {
    type <- i$type
    ones_n <- length(type[type == 1])
    zeros <- type[type == 0]
    sampled_obs <- sample(seq_len(length(zeros)), size = ones_n)
    sampled_zeros <- seq_len(length(zeros)) %in% sampled_obs
    take_this <- rep(TRUE, length(type))
    take_this[type == 1] <- TRUE
    take_this[type == 0] <- sampled_zeros
    i$take_this <- take_this
    i
  })) %>% 
  tidyr::unnest(data) %>% 
  filter(take_this)

Here I use nesting which allows for custom operations inside each group. I couldn't make sample_slice working, I used slice instead. The idea is to mark every observation with take_this = TRUE/FALSE. If the index of a zero row is sampled then it's taken.

Here is a somewhat inelegant approach, but should accomplish this. First, I created a variable that determines the number of samples based on the minimum number of observations when grouped by group and type. This part uses dplyr:

library(dplyr)
df2 <- df %>%
  mutate(nmax = max(row_number()), .by = c(group, type)) %>%
  mutate(sample_n = min(nmax), .by = group) %>% select(-nmax)

This creates a temporary variable sample_n that tells us what the minimum number of observations the smallest group contains, per group. Here we should have 2 for group == 1 and 3 for group == 2 since group sizes of type == 1 was 2 and 3, respectively:

# unique(df2[, c("group", "sample_n")])
#   group sample_n
# 1     1        2
# 8     2        3

Then in base R we can use split and sample with lapply:

set.seed(123)
ll <- lapply(split(df2, ~ df2$group + df2$type), 
             function(x) x[sample(nrow(x), max(x$sample_n)), -4])

Then combine with do.call:

df_final <- do.call(rbind, ll)
df_final <- df_final[order(df_final$group),]

All together with output:

df2 <- df %>%
  mutate(nmax = max(row_number()), .by = c(group, type)) %>%
  mutate(sample_n = min(nmax), .by = group) %>% select(-nmax)
ll <- lapply(split(df2, ~ df2$group + df2$type), 
             function(x) x[sample(nrow(x), max(x$sample_n)), -4])
df_final <- do.call(rbind, ll)
df_final <- df_final[order(df_final$group),]

#       group type value
#1.0.3      1    0     3
#1.0.2      1    0     2
#1.1.7      1    1     7
#1.1.6      1    1     6
#2.0.10     2    0     3
#2.0.9      2    0     2
#2.0.12     2    0     5
#2.1.14     2    1     7
#2.1.15     2    1     8
#2.1.16     2    1     9

Here's an alternative with slightly less code

set.seed(123)
df %>%
  group_by(group) %>%
  mutate(size = sum(type)) %>%
  filter(type == 0) %>%
  slice(sample.int(n(), size = size[1L])) %>%
  bind_rows(filter(df, type == 1))
# A tibble: 10 × 4
# Groups:   group [2]
   group  type value  size
   <dbl> <dbl> <dbl> <dbl>
 1     1     0     3     2
 2     1     0     2     2
 3     2     0     3     3
 4     2     0     2     3
 5     2     0     5     3
 6     1     1     6    NA
 7     1     1     7    NA
 8     2     1     7    NA
 9     2     1     8    NA
10     2     1     9    NA

I've generalized ThomasIsCoding's answer, and avoided the assumptions that are true for the example data, but false otherwise.

This is also the approach I used at the end:

df %>% 
  arrange(group, type) %>%
  filter(row_number() %in% c(sample(which(type == 0),
                                    sum(type == 1)),
                             which(type == 1)),
         .by = group) %>%
  group_by(group, type) %>%
  summarise(n    = n(), 
            mean = mean(value))