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个添加到另一个区域。

如何考虑所有可能性？我相信在这种情况下有八个排列。

预先感谢A。

Answer 1

如果您使用的是虚构数据，则可以为每行创建最少的数量，然后创建填充符以使总数达到最大值：

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

顺便说一句，从表格中可以看到，排列数是名称数乘以区域数。

Answer 2

这是另一种想法。

根据您所需的最终大小，可能会过多创建样本数量，从而减少某些名称/区域对，从而使总数减少。

假设您要结束总共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)的全部内容，然后采样了{{1} }，保证每个名称/区域对都有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

使用if语句和相似数量的样本进行R采样

2 个答案: