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

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

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)) {

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

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

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

Допустим, вы хотите получить в итоге 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