создавать образцы с функцией в сгруппированных данных, которые удовлетворяют условию

Question

Я хочу создать образцы, которые составляют 10% ячеек каждой группы, но в этот образец следует включить ячейки, которые соответствуют EX == 1, и дополнить образец (если необходимо) теми, которые соответствуют PL == 1.,Мне нужно повторить это много раз (1000)

Я использовал функцию, чтобы создать образец и вставить его в df.Я думаю, чтобы получить то, что я хочу, аргументы floor будут изменены.

> rep_func <- function() {
+ x %>%
+   group_by(ID) %>%
+     dplyr::mutate(s1 = 0,
+          s1 = replace(s1, sample(which(PL == 1), floor(0.1 * n())), 1)) %>%
+   pull(s1)
+ }
> n <- 2
> x[paste0("s", seq_len(n))] <- replicate(n, rep_func())
> x
   ID PL EX s1 s2
1   1  0  1  0  0
2   1  1  0  0  0
3   1  0  0  0  0
4   1  1  0  0  0
5   1  0  0  0  0
6   1  1  0  0  0
7   1  0  0  0  0
8   1  1  0  0  0
9   1  0  0  0  0
10  1  1  0  1  1
11  1  0  0  0  0
12  1  1  0  0  1
13  1  0  0  0  0
14  1  1  0  0  0
15  1  0  0  0  0
16  1  1  0  0  0
17  1  0  0  0  0
18  1  1  0  0  0
19  1  0  0  0  0
20  1  1  0  1  0
21  2  0  0  0  0
22  2  1  0  0  0
23  2  0  0  0  0
24  2  1  0  0  0
25  2  0  0  0  0
26  2  1  0  0  0
27  2  0  1  0  0
28  2  1  0  1  1
29  2  0  0  0  0
30  2  1  0  0  0

Мне нужно, чтобы числа 1 в выборках были теми ячейками, которые соответствуют EX == 1, но если необходимо завершить выборку и достичь 10%, выберите те ячейки, которые соответствуют PL == 1.Так, в примере, ID-группа 1 имеет ячейку, которая соответствует EX == 1, и она не была выбрана в s1

Answer 1

Чтобы обработать этот обновленный случай, мы создаем новую функцию с именем replace_func, которая будет вызываться для каждой группы (ID) и будет определять приоритет заполнения значений EX, и если некоторые значения все еще остаются для завершения 10%группы использует PL значения, чтобы заполнить его.

library(dplyr)

replace_func <- function(EX, PL) {
    s = integer(length(EX))
    n <- floor(0.1 * length(EX))
    ex1 <- EX == 1
    if (sum(ex1) > n)
       return(replace(s, sample(which(ex1), n), 1))
    else {
       s1 <- replace(s, ex1, 1)
       return(replace(s1, sample(which(PL == 1), n - sum(ex1)), 1))
  }
}

rep_func <- function() {
    x %>%
     group_by(ID) %>%
     mutate(s1 = replace_func(EX, PL)) %>%
     pull(s1)
}

, а затем используйте replicate, чтобы получить n количество столбцов

n <- 2
x[paste0("s", seq_len(n))] <- replicate(5, rep_func())

x
#   ID PL EX s1 s2
#1   1  0  1  1  1
#2   1  1  0  0  0
#3   1  0  0  0  0
#4   1  1  0  0  0
#5   1  0  0  0  0
#6   1  1  0  0  0
#7   1  0  0  0  0
#8   1  1  0  0  0
#9   1  0  0  0  0
#10  1  1  0  1  0
#11  1  0  0  0  0
#12  1  1  0  0  1
#13  1  0  0  0  0
#14  1  1  0  0  0
#15  1  0  0  0  0
#16  1  1  0  0  0
#17  1  0  0  0  0
#18  1  1  0  0  0
#19  1  0  0  0  0
#20  1  1  0  0  0
#21  2  0  0  0  0
#22  2  1  0  0  0
#23  2  0  0  0  0
#24  2  1  0  0  0
#25  2  0  0  0  0
#26  2  1  0  0  0
#27  2  0  1  1  1
#28  2  1  0  0  0
#29  2  0  0  0  0
#30  2  1  0  0  0