Как быстро сэмплировать из групп в R

Question

У меня есть большой набор данных, x, который содержит реплицированные значения, некоторые из которых дублируются по своим переменным:

set.seed(40)
x <- data.frame(matrix(round(runif(1000)), ncol = 10))
x_unique <- x[!duplicated(x),]

Мне нужно сэмплировать все экземпляры каждой уникальной строки в x a заданное количество раз, поэтому я создаю новую переменную, которая просто объединяет переменные для каждой строки:

# Another way of seeing x is as a single value - will be useful later
x_code <- do.call(paste0, x)
u_code <- x_code[!duplicated(x)]

Нам нужен повторный выборочный образец из x, повторяющий каждую уникальную строку s раз. Эта информация представлена ​​в векторе s:

s <- rpois(n = nrow(x_unique), lambda = 0.9)

Вопрос в том, как выбрать людей из x, чтобы достичь квоты, установленной s, для каждой уникальной строки? Вот длинный и некрасивый путь, который дает правильный результат:

for(i in 1:length(s)){
 xs <- which(x_code %in% u_code[i])
 sel <- c(sel, xs[sample(length(xs), size = s[i], replace = T)])
}

x_sampled <- x[sel, ]

Это медленно работает и громоздко писать.

Есть ли способ получить тот же результат (x_sampled в вышесказанном) быстрее и лаконичнее? Конечно, должен быть способ!

Answer 1

Ключ к эффективному выполнению этой задачи - выяснить, как работать с индексами и как максимально векторизовать. Для вашей проблемы все станет намного проще, если вы найдете индексы для каждой повторяющейся строки:

set.seed(40)
x <- data.frame(matrix(round(runif(1000)), ncol = 10))

index <- 1:nrow(x)
grouped_index <- split(index, x, drop = TRUE)
names(grouped_index) <- NULL

Тогда вы можете использовать Map() объединить индексы для выборки и количество выборок для каждой группы. Я пишу оберткуsample() защитить от раздражающего поведения, когда x имеет длину 1.

sample2 <- function(x, n, ...) {
  if (length(x) == 1) return(rep(x, n))
  sample(x, n, ...)
}

samples <- rpois(n = length(grouped_index), lambda = 0.9)
sel <- unlist(Map(sample2, grouped_index, samples, replace = TRUE))
sel
#>  [1]  66  99  99   2   6  31  90  25  42  57  14  14   8   8  12  77  60
#> [18]  17  17  92  76  76  76  70  95  36  36  36 100  91  41  41  28  69
#> [35]  69  54  54  54  54  81  64  96  35  39  29  11  74  93  82  82  24
#> [52]  46  48  48  48  51  51  73  20  37  71  71  58  16  68  94  94  94
#> [69]  80  80  80  13  13  87  87  67  67  86  49  49  88  88  52  75  47
#> [86]  89   7  79  63  78  72  72  19

Если вы хотите сохранить в первоначальном порядке, используйте sort():

sort(sel)
#>  [1]   2   6   7   8   8  11  12  13  13  14  14  16  17  17  19  20  24
#> [18]  25  28  29  31  35  36  36  36  37  39  41  41  42  46  47  48  48
#> [35]  48  49  49  51  51  52  54  54  54  54  57  58  60  63  64  66  67
#> [52]  67  68  69  69  70  71  71  72  72  73  74  75  76  76  76  77  78
#> [69]  79  80  80  80  81  82  82  86  87  87  88  88  89  90  91  92  93
#> [86]  94  94  94  95  96  99  99 100

Я думаю узкое место в этом коде будет split(): base R не имеет эффективного способа хеширования кадров данных, поэтому полагается на вставку столбцов вместе.

Answer 2

Ты можешь использовать rep() создать индексный вектор с последующим поднабором ваших данных с использованием этого индексного вектора.

Попробуй это:

idx <- rep(1:length(s), times=s)

Первые несколько значений idx. Обратите внимание, как второй ряд повторяется дважды, в то время как строка 4 отсутствует:

idx
 [1]  1  2  2  3  6  7  8 10 11 13 14 14 ......

Затем выполните подмножество. Обратите внимание, как новые дубликаты имеют имена строк, которые указывают на репликацию.

x_unique[idx, ]

     X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1     1  1  0  0  0  1  0  0  1   0
2     1  0  1  0  0  1  0  0  0   0
2.1   1  0  1  0  0  1  0  0  0   0
3     1  1  0  0  1  0  0  0  1   0
6     0  0  0  0  1  1  0  0  0   0
7     0  1  1  0  1  1  0  1  1   1
8     1  1  0  1  0  0  1  1  0   0
10    0  0  1  0  1  1  1  1  0   0
....