tidyverse function to `mutate_sample`?

Question

I'm looking to mutate a column for a random sample, e.g., mutate_sample. Does anyone know whether there is a dplyr/other tidyverse verb for this? Below is a reprex for the behavior I am looking for and an attempt to functionalize (which isn't running because I'm struggling with quasiquotation in if_else).

library(dplyr)
library(tibble)
library(rlang)

# Setup -------------------------------------------------------------------

group_size <- 10
group_n <- 1

my_cars <-
  mtcars %>% 
  rownames_to_column(var = "model") %>% 
  mutate(group = NA_real_, .after = model)


# Code to create mutated sample -------------------------------------------

group_sample <- 
  my_cars %>% 
  filter(is.na(group)) %>% 
  slice_sample(n = group_size) %>% 
  pull(model)

my_cars %>% 
  mutate(group =  if_else(model %in% group_sample, group_n, group)) %>% 
  head()
#>               model group  mpg cyl disp  hp drat    wt  qsec vs am gear carb
#> 1         Mazda RX4    NA 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
#> 2     Mazda RX4 Wag     1 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
#> 3        Datsun 710     1 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
#> 4    Hornet 4 Drive    NA 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
#> 5 Hornet Sportabout    NA 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
#> 6           Valiant    NA 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1


# Function to create mutated sample ---------------------------------------
# 
# Note: doesn't run because of var in if_else
# mutate_sample <- function(data, var, id, n, value) {
#   # browser()
#   sample <-
#     data %>% 
#     filter(is.na({{var}})) %>% 
#     slice_sample(n = n) %>% 
#     pull({{id}})
#   
#   data %>%
#     mutate(var =  if_else({{id}} %in% sample, value, {{var}}))
# }
# 
# mutate_sample(my_cars, group, model, group_size, group_n)

^{Created on 2020-10-21 by the reprex package (v0.3.0)}

Looking through SO, I found this related post: Mutate column as input to sample

Edo Edo · Accepted Answer · 2020-10-21T08:21:53

I think you could achieve your goal with this two options.

With dplyr:

mtcars %>% mutate(group = sample(`length<-`(rep(group_n, group_size), n())))

or with base R:

mtcars[sample(nrow(mtcars), group_size), "group"] <- group_n

If you need an external function to handle it, you could go with:

mutate_sample <- function(.data, .var, .size, .value) {
  
 mutate(.data, {{.var}} := sample(`length<-`(rep(.value, .size), n())))
 
}

mtcars %>% mutate_sample(group, group_size, group_n)

or

mutate_sample_rbase <- function(.data, .var, .size, .value) {
 
 .data[sample(nrow(.data), size = min(.size, nrow(.data))), 
       deparse(substitute(.var))] <- .value
 .data
 
}

mtcars %>% mutate_sample(group, group_size, group_n)

Note that if .size is bigger than the number of rows of .data, .var will be a constant equal to .value.

EDIT

If you're interested in keeping the old group, I suggest you another way to handle the problem:

library(dplyr)

# to understand this check out ?sample
resample <- function(x, ...){
 
 x[sample.int(length(x), ...)]
 
}

# this is to avoid any error in case you choose a size bigger than the available rows to select in one group
resample_max <- function (x, size) {
 
 resample(x, size = min(size, length(x)))
 
}

mutate_sample <- function(.data, .var, .size, .value) {
 
 # creare column if it doesnt exist
 if(! deparse(substitute(.var)) %in% names(.data)) .data <- mutate(.data, {{.var}} := NA)

 # replace missing values randomly keeping existing non-missing values
 mutate(.data, {{.var}} := replace({{.var}}, resample_max(which(is.na({{.var}})), .size), .value))
 
}


group_size <- 10

mtcars %>% 
 mutate_sample(group, group_size, 1) %>% 
 mutate_sample(group, group_size, 2)

#>     mpg cyl  disp  hp drat    wt  qsec vs am gear carb group
#> 1  21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4    NA
#> 2  21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4    NA
#> 3  22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1     2
#> 4  21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1     1
#> 5  18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2    NA
#> 6  18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1     1
#> 7  14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4    NA
#> 8  24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2     2
#> 9  22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2    NA
#> 10 19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4    NA
#> 11 17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4     1
#> 12 16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3     2
#> 13 17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3     1
#> 14 15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3    NA
#> 15 10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4     2
#> 16 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4     1
#> 17 14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4     1
#> 18 32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1     2
#> 19 30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2    NA
#> 20 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1    NA
#> 21 21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1     1
#> 22 15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2     1
#> 23 15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2     2
#> 24 13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4     1
#> 25 19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2     2
#> 26 27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1     2
#> 27 26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2    NA
#> 28 30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2     2
#> 29 15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4     1
#> 30 19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6    NA
#> 31 15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8     2
#> 32 21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2    NA

Notice that this solution works even with grouped_df class (what you get after a dplyr::group_by): from each group [made by dplyr::group_by] a sample of .size units will be selected.

mtcars %>% 
 group_by(am) %>% 
 mutate_sample(group, 10, 1) %>% 
 ungroup() %>% 
 count(group)
#> # A tibble: 2 x 2
#>   group     n
#>   <dbl> <int>
#> 1     1    20 # two groups, each with 10!
#> 2    NA    12

tidyverse function to `mutate_sample`?

1 Answers