从“帽子”模拟随机抽奖

【问题标题】：Simulating Random Draws From a "Hat"从“帽子”模拟随机抽奖
【发布时间】：2021-12-26 01:36:09
【问题描述】：

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

  • 迭代 3：num_var_2

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

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

【问题讨论】：

    标签： r data-manipulation


    【解决方案1】：

    据我了解，对于factor 或character 向量，我们需要一个函数来随机确定样本大小，然后从一些数据点中随机抽取样本。对于numeric 向量，我们需要一个函数来随机决定最小值和最大值之间的截止点，以及是否选择大于或小于该截止点​​的数字。最后，我们需要根据本文提供的格式来总结规则。

    考虑factors 和characters 的以下函数。它首先根据x 中的项目数决定一个随机样本大小，然后从x 中随机抽样项目。

    random_pick <- function(x) {
  sample_size <- sample.int(length(x), 1L)
  out <- x[sort(sample.int(length(x), sample_size))]
  list("=", out)
}

    另外，请考虑为numerics 使用这样的函数。它找到最小值/最大值，确定截止值和比较符号。

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

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

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

    【讨论】：

    • @ekoam：非常感谢您的回答！我将不得不花更多时间来理解您编写的代码，但它似乎工作得很好！非常感谢！我很快就能“接受”你的回答！
    • 您知道是否可以获取最终数据帧的每一行并使用它从“my_data”中选择行？像这样的东西：stackoverflow.com/questions/70504566/… ？非常感谢！
    • @stats555 您介意将过滤规则的语法更改为 R 的本机语法吗？例如，使用factor_var_1 %in% c("A", "B") 而不是factor_var_1 = "A, B"。
    【解决方案2】：

    您可以定义一个函数FUN(n) 来创建一个数据集，如 OP 所示。

    FUN <- function(n=1e3) {
  num_var_1 <- rnorm(n, 10, 1)
  num_var_2 <- rnorm(n, 10, 5)
  num_var_3 <- rnorm(n, 10, 10)
  num_var_4 <- rnorm(n, 10, 10)
  num_var_5 <- rnorm(n, 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, n, replace=TRUE, 
                                   prob=c(0.3, 0.5, 0.2)))
  factor_var_2 <- as.factor(sample(factor_2, n, replace=TRUE, 
                                   prob=c(0.5, 0.3, 0.2)))
  factor_var_3 <- as.factor(sample(factor_3, n, replace=TRUE, 
                                   prob=c(0.5, 0.2, 0.2, 0.1)))
  factor_var_4 <- as.factor(sample(factor_4, n, replace=TRUE, 
                                   prob=c(0.5, 0.2, 0.1, 0.1, 0.1)))
  factor_var_5 <- as.factor(sample(factor_5, n, replace=TRUE, 
                                   prob=c(0.3, 0.2, 0.1, 0.1, 0.1, .2)))
  id <- 1:n
  return(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))
}

    接下来，将（适当的）表达式定义为列表evl中的字符串。

    evl <- list(
  c('num_var_2 > 12', 'factor_var_1 %in% c("A", "C")', 
    'factor_var_4 %in% c("BBBB", "DDDD", "EEEE")'),
  c('num_var_1 > 0', 'num_var_3 < 10', 'factor_var_2 %in% c("AA", "BB", "CC")',
    'factor_var_3 %in% "AAA"', 'factor_var_5 %in% c("CCCCC", "DDDDD")'),
  c('num_var_2 < 5', 'num_var_5 < 10', 'factor_var_1 %in% "B"',
    'factor_var_3 %in% "AAA"'),
  c('factor_var_4 %in% "BBBB"')
)

    最后，在Map 中定义一个函数，该函数使用eval(parse(text=)) 根据各自的表达式对一个replicateion 的数据进行子集化。在函数外使用set.seed()，防止每次迭代产生相同的数据。

    set.seed(42)
result <- Map(\(x, y) x[with(x, eval(parse(text=paste(y, collapse=' & ')))), ],
              replicate(length(evl), FUN(), simplify=FALSE),
              evl)

    注意：R version 4.1.2 (2021-11-01)

    给予

    str(result)
# List of 4
# $ :'data.frame':  59 obs. of  11 variables:
#   ..$ id          : int [1:59] 3 6 25 29 32 34 52 54 58 93 ...
# ..$ num_var_1   : num [1:59] 9.99 10.95 9.38 8.53 9.65 ...
# ..$ num_var_2   : num [1:59] 13.6 17.4 20.3 19.3 16.1 ...
# ..$ num_var_3   : num [1:59] 9.42 18.67 6.1 25.71 -2.73 ...
# ..$ num_var_4   : num [1:59] 6.29 9.22 3.68 16.27 15.77 ...
# ..$ num_var_5   : num [1:59] 13.37 18.86 4.89 24.18 26.11 ...
# ..$ factor_var_1: Factor w/ 3 levels "A","B","C": 3 1 3 1 3 3 1 3 1 1 ...
# ..$ factor_var_2: Factor w/ 3 levels "AA","BB","CC": 3 3 1 1 1 2 3 3 1 3 ...
# ..$ factor_var_3: Factor w/ 4 levels "AAA","BBB","CCC",..: 1 1 2 1 1 4 2 1 3 2 ...
# ..$ factor_var_4: Factor w/ 5 levels "AAAA","BBBB",..: 5 2 2 2 2 2 5 2 4 4 ...
# ..$ factor_var_5: Factor w/ 6 levels "AAAAA","BBBBB",..: 3 5 2 3 5 4 4 6 1 6 ...
# $ :'data.frame':  53 obs. of  11 variables:
#   ..$ id          : int [1:53] 2 14 28 36 49 59 75 103 134 137 ...
# ..$ num_var_1   : num [1:53] 9.67 11.61 11.22 10.14 10.5 ...
# ..$ num_var_2   : num [1:53] 10.89 7.12 2.38 13.28 10.88 ...
# ..$ num_var_3   : num [1:53] 5.87 7.33 2.88 -10.78 4.09 ...
# ..$ num_var_4   : num [1:53] 19.239 6.261 -0.158 14.586 -0.544 ...
# ..$ num_var_5   : num [1:53] -5.1 21.04 2.81 1.76 27.19 ...
# ..$ factor_var_1: Factor w/ 3 levels "A","B","C": 1 1 1 2 3 2 3 3 2 3 ...
# ..$ factor_var_2: Factor w/ 3 levels "AA","BB","CC": 2 2 2 3 3 3 3 2 1 1 ...
# ..$ factor_var_3: Factor w/ 4 levels "AAA","BBB","CCC",..: 1 1 1 1 1 1 1 1 1 1 ...
# ..$ factor_var_4: Factor w/ 5 levels "AAAA","BBBB",..: 1 5 5 1 4 4 4 4 1 4 ...
# ..$ factor_var_5: Factor w/ 6 levels "AAAAA","BBBBB",..: 3 4 4 3 3 4 4 4 4 3 ...
# $ :'data.frame':  20 obs. of  11 variables:
#   ..$ id          : int [1:20] 3 44 91 181 222 233 241 287 293 302 ...
# ..$ num_var_1   : num [1:20] 12 10.26 9.65 8.48 12.1 ...
# ..$ num_var_2   : num [1:20] 3.68 3.61 3.28 4.01 1.78 ...
# ..$ num_var_3   : num [1:20] 4.113 -3.481 17.654 0.496 5.457 ...
# ..$ num_var_4   : num [1:20] 9.25 19.79 17.15 -4.72 22.16 ...
# ..$ num_var_5   : num [1:20] 6 8.49 4.31 4.67 1.96 ...
# ..$ factor_var_1: Factor w/ 3 levels "A","B","C": 2 2 2 2 2 2 2 2 2 2 ...
# ..$ factor_var_2: Factor w/ 3 levels "AA","BB","CC": 2 1 3 1 1 1 1 3 2 1 ...
# ..$ factor_var_3: Factor w/ 4 levels "AAA","BBB","CCC",..: 1 1 1 1 1 1 1 1 1 1 ...
# ..$ factor_var_4: Factor w/ 5 levels "AAAA","BBBB",..: 3 1 1 1 1 1 1 1 1 1 ...
# ..$ factor_var_5: Factor w/ 6 levels "AAAAA","BBBBB",..: 3 5 5 1 1 1 2 6 1 2 ...
# $ :'data.frame':  205 obs. of  11 variables:
#   ..$ id          : int [1:205] 7 10 23 24 27 29 31 33 38 40 ...
# ..$ num_var_1   : num [1:205] 10.23 9.78 8.92 10.16 9.93 ...
# ..$ num_var_2   : num [1:205] 23.49 13.06 12.17 16.88 7.93 ...
# ..$ num_var_3   : num [1:205] 6.33 9.33 14.04 21.66 28.56 ...
# ..$ num_var_4   : num [1:205] 16.33 -1.805 0.509 21.2 15.158 ...
# ..$ num_var_5   : num [1:205] 8.48 -1.31 5.03 15.07 19.48 ...
# ..$ factor_var_1: Factor w/ 3 levels "A","B","C": 1 1 2 1 2 1 2 2 3 2 ...
# ..$ factor_var_2: Factor w/ 3 levels "AA","BB","CC": 3 1 1 2 1 1 1 2 1 3 ...
# ..$ factor_var_3: Factor w/ 4 levels "AAA","BBB","CCC",..: 1 2 3 1 3 4 3 1 3 2 ...
# ..$ factor_var_4: Factor w/ 5 levels "AAAA","BBBB",..: 2 2 2 2 2 2 2 2 2 2 ...
# ..$ factor_var_5: Factor w/ 6 levels "AAAAA","BBBBB",..: 3 5 2 6 6 2 6 1 2 2 ...

    【讨论】：

    • @ jay.sf ：非常感谢您的回答！但我不认为这就是我要找的东西？我正在寻找更多类似的东西：stackoverflow.com/questions/70477594/…
    • 例如，假设有三顶帽子，每顶帽子包含 10 个球。还有三桶沙子，每桶沙子1公斤。总共有 6 个容器（3 个帽子和 3 个桶）。首先，您选择随机数量的容器（例如，假设您选择了 3 个容器：帽子 2、帽子 3、桶 1）。然后，您从帽子 2 中挑选随机数量的球（例如 4 个球），从帽子 3 中选择随机数量的球（例如 7 个球），然后从桶 1 中舀出随机数量的沙子（例如 153 克）沙）。这是迭代 #1。
    • 然后，你再次重复整个练习——这一次，你选择帽子 1、桶 2、桶 3。这一次，你碰巧从帽子 1 中选择了 5 个球，从桶中选择了 103 克沙子2 和 641 克来自桶 3 的沙子。这是迭代 #2
    • 我想创建一个“n”行 x 2 列的表，其中包含每次迭代的结果。第一列是迭代次数，第二列包含随机选择的变量，以及从每个变量中选择的“范围”。
    • 非常感谢您的帮助！
    猜你喜欢
    • 2013-07-09
    • 2012-11-27
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-06-14
    • 1970-01-01
    • 1970-01-01
    • 2013-12-18
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode