带有if语句的R采样和相似数量的样本
R sampling with if statement and similar number of sample
我需要从我的数据框中创建一个样本，为此我使用了下面的代码。
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
和指定数量的样本。
我预计有时某个特定组不会有所需的人数。在我的示例中，我从名为 "test" 的区域采集了 20 个样本，但有时只会有 10 行包含 "test"。总数是 50，所以我需要确定是否只有 10 "test" 代码必须自动增加其他的，所以样本将是 "test" - 10，"run" - 20和 "develop" - 20。这可能发生在任何区域，因此我需要测试是否有足够的行来创建示例并增加其他区域。如果只有 1，则可以将其添加到任何剩余区域，或者如果差异为 3，我们将 1 添加到一个区域，将 2 添加到另一个区域。
考虑到所有可能性，我该如何检查？我相信在这种情况下有八种排列。
提前致谢 A.
如果您使用的是编造的数据，那么您可以为每行创建一个最小数量，然后创建填充以达到总数：
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)) {
顺便说一句，排列数，正如您在 table 中看到的，是名称数乘以区域数。
这是另一个想法。
根据您想要的最终大小，它可能会过度创建样本数量，以便它可以减少一些 name/area 对以降低总数。
假设您希望最终得到 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
验证每个 name/area:
的样本量是否相同
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), 保证 每个 name/area 对有 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
我需要从我的数据框中创建一个样本，为此我使用了下面的代码。
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
和指定数量的样本。
我预计有时某个特定组不会有所需的人数。在我的示例中，我从名为 "test" 的区域采集了 20 个样本，但有时只会有 10 行包含 "test"。总数是 50，所以我需要确定是否只有 10 "test" 代码必须自动增加其他的，所以样本将是 "test" - 10，"run" - 20和 "develop" - 20。这可能发生在任何区域，因此我需要测试是否有足够的行来创建示例并增加其他区域。如果只有 1，则可以将其添加到任何剩余区域，或者如果差异为 3，我们将 1 添加到一个区域，将 2 添加到另一个区域。
考虑到所有可能性，我该如何检查？我相信在这种情况下有八种排列。
提前致谢 A.
如果您使用的是编造的数据，那么您可以为每行创建一个最小数量，然后创建填充以达到总数：
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)) {
顺便说一句，排列数，正如您在 table 中看到的，是名称数乘以区域数。
这是另一个想法。
根据您想要的最终大小，它可能会过度创建样本数量，以便它可以减少一些 name/area 对以降低总数。
假设您希望最终得到 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
验证每个 name/area:
的样本量是否相同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), 保证 每个 name/area 对有 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