模拟随机抽签(&Q;) [英] Simulating Random Draws From a "Hat"
问题描述
假设我有10个变量(num_var_1、num_var_2、num_var_3、num_var_4、num_var_5、factor_var_1、factor_var_2、factor_var_3、factor_var_4、factor_var_5):
set.seed(123)
num_var_1 <- rnorm(1000, 10, 1)
num_var_2 <- rnorm(1000, 10, 5)
num_var_3 <- rnorm(1000, 10, 10)
num_var_4 <- rnorm(1000, 10, 10)
num_var_5 <- rnorm(1000, 10, 10)
factor_1 <- c("A","B", "C")
factor_2 <- c("AA","BB", "CC")
factor_3 <- c("AAA","BBB", "CCC", "DDD")
factor_4 <- c("AAAA","BBBB", "CCCC", "DDDD", "EEEE")
factor_5 <- c("AAAAA","BBBBB", "CCCCC", "DDDDD", "EEEEE", "FFFFFF")
factor_var_1 <- as.factor(sample(factor_1, 1000, replace=TRUE, prob=c(0.3, 0.5, 0.2)))
factor_var_2 <- as.factor(sample(factor_2, 1000, replace=TRUE, prob=c(0.5, 0.3, 0.2)))
factor_var_3 <- as.factor(sample(factor_3, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.2, 0.1)))
factor_var_4 <- as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.1, 0.1, 0.1)))
factor_var_5 <- as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.3, 0.2, 0.1, 0.1, 0.1)))
id = 1:1000
my_data = data.frame(id,num_var_1, num_var_2, num_var_3, num_var_4, num_var_5, factor_var_1, factor_var_2, factor_var_3, factor_var_4, factor_var_5)
> head(my_data)
id num_var_1 num_var_2 num_var_3 num_var_4 num_var_5 factor_var_1 factor_var_2 factor_var_3 factor_var_4 factor_var_5
1 1 9.439524 5.021006 4.883963 8.496925 11.965498 B AA AAA CCCC AAAA
2 2 9.769823 4.800225 12.369379 6.722429 16.501132 B AA AAA AAAA AAAA
3 3 11.558708 9.910099 4.584108 -4.481653 16.710042 C AA BBB AAAA CCCC
4 4 10.070508 9.339124 22.192276 3.027154 -2.841578 B CC DDD BBBB AAAA
5 5 10.129288 -2.746714 11.741359 35.984902 -10.261096 B AA AAA DDDD DDDD
6 6 11.715065 15.202867 3.847317 9.625850 32.053261 B AA CCC BBBB EEEE
我的问题:我感兴趣的是从这些数据中选择随机数量的变量,并从这些变量中提取随机子集。(然后重复这个过程很多次)。例如,我想记录这样一个随机生成的列表:
迭代1:num_var_2>;12,factor_var_1=";A,C";,factor_var_4=";BBBB,DDDD,eeee";
迭代2:num_var_1&>0,num_var_3<;10,factor_var_2=";aa,bb,cc";,factor_var_3=";aaa";,factor_var_5=";CCCCC,ddd";
迭代3:num_var_2<;5,num_var_5<;10,factor_var_1=";B";,factor_var_3=";aaa";
迭代4:factor_var_4=";bbbb";
等
我可以手动执行上述操作,但这会花费很长时间(例如,10次迭代)。有没有一种方法可以自动执行这个过程,最后输出这样的列表(10行×2列):Iteration Condition
1 num_var_2 > 12, factor_var_1 = A, C, factor_var_4 = BBBB, DDDD, EEEE
2 num_var_1 >0, num_var_3 <10, factor_var_2 = AA, BB, CC, factor_var_3 = AAA, factor_var_5 = CCCCC, DDDDD
3 num_var_2 <5, num_var_5 <10, factor_var_1 = B, factor_var_3 = AAA
4 factor_var_4 = BBBB
有人能教我怎么做吗?
推荐答案
据我所知,对于factor
或character
向量,我们需要一个函数来随机决定样本大小,然后从一些数据点中随机抽取样本。对于numeric
向量,我们需要一个函数来随机决定最小值和最大值之间的分界点,以及选择大于或小于该分界点的数字。最后,我们需要根据本文提供的格式总结规则。
考虑factor
和character
的以下函数。它首先根据x
中的项目数决定随机样本大小,然后从x
中随机抽样项目。
random_pick <- function(x) {
sample_size <- sample.int(length(x), 1L)
out <- x[sort(sample.int(length(x), sample_size))]
list("=", out)
}
另外,请考虑numeric
s的类似函数。它查找最小/最大值、确定分界值和符号以进行比较。
random_trunc <- function(x) {
rng <- range(x)
cutoff <- runif(1L, rng[[1L]], rng[[2L]])
sgn <- c("<", ">")[[sample.int(2L, 1L)]]
list(sgn, cutoff)
}
然后,我们将这两个函数组合在一起,以满足您的特定情况。请注意,对于character
%s,我们只需要选择唯一的。
random_select <- function(x) {
if (is.numeric(x))
return(random_trunc(x))
if (is.factor(x))
return(random_pick(levels(x)))
random_pick(unique(x))
}
report
根据提供的格式生成所需的规则。
report <- function(f) function(...) {
x <- f(...)
if (x[[1L]] != "=")
return(sprintf("%s %.2f", x[[1L]], x[[2L]]))
sprintf("%s "%s"", x[[1L]], paste0(x[[2L]], collapse = ", "))
}
现在我们已经准备好编写从数据集随机生成规则的函数。其思路是首先从所有变量中随机选择(第一个变量id
除外),然后对每个选定变量应用random_rule
,最后汇总结果。
random_rule <- function(dt) {
out <- vapply(
dt[random_pick(names(dt)[-1L])[[2L]]],
report(random_select), character(1L)
)
paste(names(out), out, collapse = ", ")
}
因此,我们可以根据需要对任意数量的迭代执行此操作
set.seed(123)
data.frame(iteration = 1:10, results = replicate(10L, random_rule(my_data)))
结果
> set.seed(123)
> data.frame(iteration = 1:10, records = replicate(10L, random_rule(my_data)))
iteration
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8
9 9
10 10
records
1 num_var_2 < 12.51, num_var_3 > 41.50, factor_var_1 = "A, B"
2 num_var_1 < 11.16, num_var_3 > 15.63, num_var_4 > -3.87, factor_var_2 = "BB", factor_var_4 = "AAAA, BBBB, DDDD"
3 num_var_1 < 9.87, num_var_2 < -1.32, num_var_3 > -5.54, num_var_4 > 24.09, num_var_5 < 3.28, factor_var_2 = "AA, BB, CC", factor_var_3 = "CCC"
4 num_var_1 > 9.72, num_var_2 > -1.93, num_var_3 < 43.27, num_var_4 < 32.11, num_var_5 > -12.77, factor_var_1 = "B", factor_var_2 = "AA", factor_var_4 = "AAAA, BBBB, DDDD", factor_var_5 = "AAAA"
5 num_var_1 > 10.51, num_var_2 > 13.61, num_var_3 > 22.14, num_var_4 < -2.75, factor_var_1 = "A, B, C", factor_var_3 = "AAA", factor_var_4 = "BBBB, DDDD, EEEE"
6 factor_var_1 = "A, B, C", factor_var_5 = "BBBB, CCCC, EEEE"
7 num_var_1 > 9.34, num_var_2 < 18.59, num_var_3 < 7.39, num_var_4 > 16.66, num_var_5 > 35.48, factor_var_1 = "C", factor_var_2 = "AA, BB, CC", factor_var_4 = "AAAA, BBBB, CCCC"
8 num_var_1 > 10.66, num_var_2 > 25.74, num_var_3 > 13.81, num_var_4 > 31.73, num_var_5 > -2.40, factor_var_1 = "A, B, C", factor_var_2 = "AA, BB", factor_var_3 = "AAA, CCC, DDD", factor_var_4 = "AAAA, BBBB, CCCC, DDDD, EEEE", factor_var_5 = "DDDD"
9 num_var_1 < 10.78, num_var_2 < 11.86, num_var_3 < -7.95, num_var_4 < 7.12, num_var_5 > 39.57, factor_var_1 = "A, B, C", factor_var_2 = "AA, BB, CC", factor_var_3 = "CCC", factor_var_4 = "BBBB, EEEE", factor_var_5 = "AAAA, BBBB, CCCC, DDDD, EEEE"
10 num_var_1 < 7.63, num_var_2 > 19.04, num_var_4 > 37.87, num_var_5 < -14.85, factor_var_1 = "A, B", factor_var_2 = "AA, CC", factor_var_4 = "AAAA, CCCC"
把所有东西放在一起
random_pick <- function(x) {
sample_size <- sample.int(length(x), 1L)
out <- x[sort(sample.int(length(x), sample_size))]
list("=", out)
}
random_trunc <- function(x) {
rng <- range(x)
cutoff <- runif(1L, rng[[1L]], rng[[2L]])
sgn <- c("<", ">")[[sample.int(2L, 1L)]]
list(sgn, cutoff)
}
random_select <- function(x) {
if (is.numeric(x))
return(random_trunc(x))
if (is.factor(x))
return(random_pick(levels(x)))
random_pick(unique(x))
}
report <- function(f) function(...) {
x <- f(...)
if (x[[1L]] != "=")
return(sprintf("%s %.2f", x[[1L]], x[[2L]]))
sprintf("%s "%s"", x[[1L]], paste0(x[[2L]], collapse = ", "))
}
random_rule <- function(dt) {
out <- vapply(
dt[random_pick(names(dt)[-1L])[[2L]]],
report(random_select), character(1L)
)
paste(names(out), out, collapse = ", ")
}
set.seed(123)
data.frame(iteration = 1:10, records = replicate(10L, random_rule(my_data)))
这篇关于模拟随机抽签(&Q;)的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!