无替代的条件抽样

Question

我试图编写一个模拟,涉及随机地将项目重新分配给具有一些限制的类别.

可以说我有一个分布在A到J之间的鹅卵石1到N的集合:

set.seed(100)
df1 <- data.frame(pebble = 1:100, 
                  bucket = sample(LETTERS[1:10], 100, T), 
                  stringsAsFactors = F)
head(df1)
#>   pebble bucket
#> 1      1      D
#> 2      2      C
#> 3      3      F
#> 4      4      A
#> 5      5      E
#> 6      6      E

我想随机重新分配鹅卵石到水桶.没有限制我可以这样做:

random.permutation.df1 <- data.frame(pebble = df1$pebble, bucket = sample(df1$bucket))
colSums(table(random.permutation.df1))
#>  A  B  C  D  E  F  G  H  I  J 
#>  4  7 13 14 12 11 11 10  9  9
colSums(table(df1))
#>  A  B  C  D  E  F  G  H  I  J 
#>  4  7 13 14 12 11 11 10  9  9

重要的是,这会重新分配鹅卵石,同时确保每个桶保留相同的数量(因为我们在不更换的情况下进行取样).

但是,我有一系列限制,以至于某些鹅卵石无法分配给某些水桶.我将限制编码在df2:

df2 <- data.frame(pebble = sample(1:100, 10), 
                  bucket = sample(LETTERS[1:10], 10, T), 
                  stringsAsFactors = F)
df2
#>    pebble bucket
#> 1      33      I
#> 2      39      I
#> 3       5      A
#> 4      36      C
#> 5      55      J
#> 6      66      A
#> 7      92      J
#> 8      95      H
#> 9       2      C
#> 10     49      I

这里的逻辑是鹅卵石33和39不能放在桶I中,或者桶A中的鹅卵石5等等.我想置换哪些鹅卵石在哪些桶中受到这些限制.

到目前为止,我已经考虑过在下面的循环中处理它,但这并不会导致桶保留相同数量的鹅卵石:

perms <- character(0)
cnt <- 1
for (p in df1$pebble) {
  perms[cnt] <- sample(df1$bucket[!df1$bucket %in% df2$bucket[df2$pebble==p]], 1)
  cnt <- cnt + 1
}
table(perms)
#> perms
#>  A  B  C  D  E  F  G  H  I  J 
#>  6  7 12 22 15  1 14  7  7  9

然后我尝试采样位置,然后从可用的存储桶和可用的剩余位置中移除该位置.这也行不通,我怀疑这是因为我正在采样树进入不产生解决方案的树枝.

set.seed(42)
perms <- character(0)
cnt <- 1
ids <- 1:nrow(df1)
bckts <- df1$bucket
for (p in df1$pebble) {
  id <- sample(ids[!bckts %in% df2$bucket[df2$pebble==p]], 1)
  perms[cnt] <- bckts[id]
  bckts <- bckts[-id]
  ids <- ids[ids!=id]
  cnt <- cnt + 1
}
table(perms)
#> perms
#> A B C D E F G J 
#> 1 1 4 1 2 1 2 2 

任何想法或建议都非常感激(并且长篇大论道歉).

编辑:

我愚蠢地忘了澄清我以前通过重新采样来解决这个问题,直到我得到一个没有违反任何条件的抽奖df2,但我现在有很多条件会使我的代码运行时间过长.如果我能找到一种方法来加快它的速度,我仍然会努力强迫它.

Answer 1

我有一个解决方案（我设法用基础 R 编写它，但 data.table 解决方案更容易理解和编写：

\n\n

random.permutation.df2 <- data.frame(pebble = df1$pebble, bucket = rep(NA,length(df1$pebble)))\nfor(bucket in unique(df1$bucket)){\n  N <-  length( random.permutation.df2$bucket[is.na(random.permutation.df2$bucket) & \n                                         !random.permutation.df2$pebble %in% df2$pebble[df2$bucket == bucket] ] )\n  random.permutation.df2$bucket[is.na(random.permutation.df2$bucket) & \n                                  !random.permutation.df2$pebble %in% df2$pebble[df2$bucket == bucket] ] <- \n    sample(c(rep(bucket,sum(df1$bucket == bucket)),rep(NA,N-sum(df1$bucket == bucket))))\n\n}\n

\n\n

这个想法是对每个存储桶的授权 Peeble 进行采样：那些不在 df2 中的存储桶，以及那些尚未填充的存储桶。然后，您对一个合适长度的向量进行采样，在 NA（对于以下存储桶值）和循环中的值之间进行选择，然后 voil\xc3\xa0。

\n\n

现在使用 data.table 更容易阅读

\n\n

library(data.table)\nrandom.permutation.df2 <- setDT(random.permutation.df2)\ndf2 <- setDT(df2)\n\nfor( bucketi in unique(df1$bucket)){\n random.permutation.df2[is.na(bucket) & !pebble %in% df2[bucket == bucketi, pebble], \n                        bucket := sample(c(rep(bucketi,sum(df1$bucket == bucket)),rep(NA,.N-sum(df1$bucket == bucket))))] \n}\n

\n\n

它有两个条件

\n\n

> colSums(table(df1))\n A  B  C  D  E  F  G  H  I  J \n 4  7 13 14 12 11 11 10  9  9 \n> colSums(table(random.permutation.df2))\n A  B  C  D  E  F  G  H  I  J \n 4  7 13 14 12 11 11 10  9  9 \n

\n\n

验证与df2不存在矛盾

\n\n

> df2\n    pebble bucket\n 1:     37      D\n 2:     95      H\n 3:     90      C\n 4:     80      C\n 5:     31      D\n 6:     84      G\n 7:     76      I\n 8:     57      H\n 9:      7      E\n10:     39      A\n> random.permutation.df2[pebble %in% df2$pebble,.(pebble,bucket)]\n    pebble bucket\n 1:      7      D\n 2:     31      H\n 3:     37      J\n 4:     39      F\n 5:     57      B\n 6:     76      E\n 7:     80      F\n 8:     84      B\n 9:     90      H\n10:     95      D\n

\n