R выборка с оператором if и аналогичным номером выборки

Question

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

 name <- sample(c("Adam","John","Henry","Mike"),100,rep = TRUE)
 area <- sample(c("run","develop","test"),100,rep = TRUE)
 id <- sample(100:200,100,rep = FALSE)

 mydata <- as.data.frame(cbind(id,area,name))


qcsample <- mydata %>%
  group_by(area) %>% 
  nest() %>%            
  mutate(n = c(20, 15, 15)) %>% 
  mutate(samp = map2(data, n, sample_n)) %>% 
  select(area, samp) %>%
  unnest()

Теперь я получаю эти результаты.

table(qcsample$area) 

develop     run    test 
     15      15      20 

-

table(qcsample$name)

Adam Henry  John  Mike 

    9     9    16    16 

Я хотел бы создать семпл, в котором было бы более или менее одинаковое количество семплов для каждого имени, например. Адам - ​​12, Генри - 12, Джон - 13, Майк - 13. Как я могу этого достичь? могу ли я как-то потребовать, чтобы образец был равномерно распределен?

Также в этом примере я использовал функцию

sample_n

и указанное количество образцов.

Я ожидаю, что иногда не будет требуемого номера из данной группы. В моем примере я беру 20 выборок из области, называемой «тест», но иногда будет только, скажем, 10 строк, содержащих «тест». Общее число равно 50, поэтому мне нужно убедиться, что при наличии только 10 «тестов» код должен автоматически увеличивать остальные, так что пример будет «тест» - 10, «запуск» - 20 и «разработка» - 20 Это может произойти с любой областью, поэтому мне нужно проверить, достаточно ли строк для создания образца и увеличения других областей. Если есть только 1, он может быть добавлен к любой из оставшихся областей или если разница равна 3, мы добавляем 1 к одной области и 2 к другой.

Как я могу проверить это с учетом всех возможностей? Я считаю, что в этом случае есть восемь перестановок.

Заранее спасибо А.

Answer 1

Вот еще одна мысль.

В зависимости от желаемого конечного размера, это может привести к чрезмерному созданию количества выборок, что может привести к уменьшению некоторых пар имя / область для уменьшения общего количества.

Допустим, вы хотите в итоге получить 50 строк:

final_size <- 50

Для полноты вот наборы, из которых мы выберем:

avail_names <- c("Adam", "John", "Henry", "Mike")
avail_areas <- c("run", "develop", "test")

и минимум, который нам нужно создать для Adam,run (и т. Д.), Чтобы определенно в конечном итоге содержало не менее final_size строк:

size_per_namearea <- ceiling(final_size / (length(avail_names) * length(avail_areas)))

Хорошо, сгенерируйте по крайней мере столько (вероятно, больше, чем) количество строк, которое нам нужно:

set.seed(20180920)
qcsample <- crossing(data_frame(rownum = seq_len(size_per_namearea)),
                     data_frame(name   = avail_names),
                     data_frame(area   = avail_areas)) %>%
  group_by(name, area) %>%
  mutate(id = sample(100, size = n(), replace = FALSE))
qcsample
# # A tibble: 60 x 4
# # Groups:   name, area [12]
#    rownum name  area       id
#     <int> <chr> <chr>   <int>
#  1      1 Adam  run        59
#  2      1 Adam  develop    51
#  3      1 Adam  test       23
#  4      1 John  run        71
#  5      1 John  develop     5
#  6      1 John  test       24
#  7      1 Henry run         4
#  8      1 Henry develop    29
#  9      1 Henry test       79
# 10      1 Mike  run        77
# # ... with 50 more rows

Убедитесь, что у нас есть идентичные размеры выборки для каждого имени / области:

xtabs(~ name + area, data = qcsample) %>%
  stats::addmargins()
#        area
# name    develop run test Sum
#   Adam        5   5    5  15
#   Henry       5   5    5  15
#   John        5   5    5  15
#   Mike        5   5    5  15
#   Sum        20  20   20  60

Если мы просто сделаем head(final_size), тогда мы знаем , какие имена мы будем сокращать, что немного подрывает случайность вашей выборки. Причина, по которой я добавил rownum заранее, заключалась в том, что я могу организовать по нему плюс джиттер , гарантируя, что я получу все max(rownum)-1, а затем некоторую выборку max(rownum), , гарантирующую что каждая пара имя / область имеет строки max(rownum)-1 или max(rownum); Ваши результаты никогда не отличаются более чем на 1.

reducedsample <- arrange(qcsample, rownum + runif(n()))  %>%
  head(final_size) %>%
  select(-rownum)
reducedsample %>%
  xtabs(~ name + area, data = .) %>%
  stats::addmargins()
#        area
# name    develop run test Sum
#   Adam        4   4    5  13
#   Henry       5   4    4  13
#   John        4   4    4  12
#   Mike        4   4    4  12
#   Sum        17  16   17  50

Answer 2

Если вы используете составленные данные, вы можете создать минимальное количество каждой строки, а затем создать заполнитель, чтобы получить общее количество:

set.seed(42)

names <- c("Adam", "John", "Henry", "Mike")
areas <- c("run", "develop", "test")

totalrows <- 100
minname   <-  22 # No less than 20 of each name (set to near threshold to test)
minarea   <-  30 # No less than 30 of each area (less randomness the higher these are)

qcsample <- data.frame(
  name=sample(c(rep(names, minname), sample(names, totalrows-length(names)*minname, replace=T))),
  area=sample(c(rep(areas, minarea), sample(areas, totalrows-length(areas)*minarea, replace=T))),
  id=sample(99+(1:totalrows))
)

В результате:

R> table(qcsample$name)

 Adam Henry  John  Mike 
   23    28    24    25 
R> table(qcsample$area)

develop     run    test 
     37      31      32

Обратите внимание, что число от name до area не ограничено:

R> table(qcsample[,-3])
       area
name    develop run test
  Adam        5  11    7
  Henry      11   8    9
  John       10   7    7
  Mike       11   5    9
R> 

Использование цикла, предложенного @ r2evans:

library(dplyr)
set.seed(42)

mydata <- data.frame(
  name = sample(c("Adam","John","Henry","Mike"), 100, rep = TRUE),
  area = sample(c("run","develop","test"), 100, rep = TRUE),
  id   = sample(100:200, 100, rep = FALSE)
)

Nsamples <- 50
mysample <- data.frame(sample_n(mydata, Nsamples))

minname <- 11  # max is 50/4 -> 12 
minarea <- 15  # max is 50/3 -> 16

# the test you were asking about
while( (min(table(mysample$name)) < minname) || (min(table(mysample$area)) < minarea) ) {
  mysample <- data.frame(sample_n(mydata, Nsamples))
}

В результате:

R> table(mysample$name)

 Adam Henry  John  Mike 
   13    15    11    11 

R> table(mysample$area)

develop     run    test 
     15      17      18 

И, как и раньше, имени области не существует.

R> table(mysample[-3])
       area
name    develop run test
  Adam        4   3    6
  Henry       2   6    7
  John        4   4    3
  Mike        5   4    2

Если вам нужно было ввести минимальное число для каждой перестановки, добавьте это в тест:

while(... || (min(table(mysample[-3])) < some_min)) {

Кстати, количество перестановок, как видно из таблицы, - это количество имен, умноженное на количество областей.