r - 从 "Hat"模拟随机抽取

Question

假设我有以下 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，DDDDD”

• 迭代 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

有人可以告诉我怎么做吗？

Answer 1

据我了解，对于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。它找到最小值/最大值，确定截止值和比较符号。

random_trunc <- function(x) {
  rng <- range(x)
  cutoff <- runif(1L, rng[[1L]], rng[[2L]])
  sgn <- c("<", ">")[[sample.int(2L, 1L)]]
  list(sgn, cutoff)
}

然后，我们针对您的具体情况将这两个函数组合在一起。请注意，对于 character，我们只需要选择唯一的。

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