将元素重复随机分配给有限数量的组

Question

有 N 个

组（又名法官，假设 17 个）和 M 个元素（我们称它们为案例，假设 22 个），使得 3*M <= 4*N。

N <- LETTERS[1:17]
M <- 1:22

我想给N名法官每人分配4个或更少的案件，这样每个案件由不多于或不少于3名法官进行评估，并且没有法官两次看到同一个案件。

A : 1, 2, 19
B : 2, 3, 8, 22
...
Q : 1, 2, 12, 10

有什么快速简便的方法可以在 R 中做到这一点吗？

到目前为止尝试过：

df <- data.frame(ID=rep(M,3))
values <- N
df$values[sample(1:nrow(df), nrow(df), FALSE)] <- rep(values, 4)

Answer 1

通常当我看到"受约束的随机分配"问题时，我的脑海中会想到以下想法：

1. 选择一个随机权重以将项目 i 分配给类别 j（在本例中将案例 i 分配给判断 j）
2. 使用线性规划确定满足所有约束（<= 4 个案例/法官和每个案例 3 个审查）且具有最大权重的分配。

这在 R 中非常简单，使用像 lpSolve 这样的线性编程包，创建一个二进制变量x_ij，指示我们是否为每个案例/法官对分配案例 i 来判断 j：

library(lpSolve)
set.seed(144)
# vars is a convenience matrix that tells us the i and j index of each variable in our model
vars <- expand.grid(i=M, j=N)
mod <- lp(direction = "max",
          objective.in = rnorm(nrow(vars)),
          const.mat = rbind(t(sapply(M, function(i) as.numeric(vars$i == i))),
                            t(sapply(N, function(j) as.numeric(vars$j == j)))),
          const.dir = rep(c("=", "<="), c(length(M), length(N))),
          const.rhs = rep(c(3, 4), c(length(M), length(N))),
          all.bin = TRUE)
# Extract all cases assigned to each judge
sapply(N, function(j) vars$i[mod$solution > 0.999 & vars$j == j])
# $A
# [1]  2 10 15
# 
# $B
# [1]  7  8 13 22
# 
# $C
# [1] 2 3 7 9
# ...

顺便说一下，我们已经设置了权重和约束，这实际上可以被认为是从所有可行的案件分配给法官中随机选择。

Answer 2

以下是我会做的：

set.seed(1)
rM = sample(M)
rN = sample(N)
tasks  = rep(rM, each=3)
judges = rep(rN, length.out = length(tasks))
matches = data.frame(judges, tasks)

您可以通过制表来验证您的条件是否成立：

tab = with(matches, table(judges, tasks))
max(tab) # 1
addmargins(tab)
      tasks
judges  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sum
   A    0  0  0  0  0  0  1  1  0  1  1  0  0  0  0  0  0  0  0  0  0  0   4
   B    1  0  0  0  0  0  0  0  0  0  0  0  0  1  0  0  0  1  0  0  1  0   4
   C    0  1  0  0  0  1  0  0  0  0  0  0  0  0  0  0  1  0  0  0  0  1   4
   D    0  0  0  0  0  0  0  0  1  0  0  1  0  0  0  0  0  0  1  1  0  0   4
   E    0  0  0  0  0  1  1  0  0  0  0  0  0  0  0  0  1  0  0  0  0  1   4
   F    0  0  0  0  0  0  1  1  0  0  1  0  0  0  0  0  1  0  0  0  0  0   4
   G    0  0  1  1  1  0  0  0  0  0  0  0  1  0  0  0  0  0  0  0  0  0   4
   H    1  0  0  1  0  0  0  0  0  0  0  0  1  1  0  0  0  0  0  0  0  0   4
   I    0  0  0  0  0  0  0  0  1  0  0  0  0  0  1  0  0  1  0  0  1  0   4
   J    0  0  0  0  0  0  0  0  0  1  0  1  0  0  0  0  0  0  1  1  0  0   4
   K    1  0  0  0  0  0  0  0  0  0  0  0  0  0  1  0  0  1  0  0  1  0   4
   L    0  1  0  0  0  1  0  0  0  0  0  0  0  0  0  1  0  0  0  0  0  1   4
   M    0  0  1  0  1  0  0  0  0  0  0  0  0  0  0  1  0  0  0  0  0  0   3
   N    0  1  0  0  1  0  0  0  0  0  0  0  0  0  0  1  0  0  0  0  0  0   3
   O    0  0  0  0  0  0  0  1  0  1  1  0  0  0  0  0  0  0  1  0  0  0   4
   P    0  0  1  1  0  0  0  0  0  0  0  0  1  1  0  0  0  0  0  0  0  0   4
   Q    0  0  0  0  0  0  0  0  1  0  0  1  0  0  1  0  0  0  0  1  0  0   4
   Sum  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  66

注：rN接近的法官将得出类似的案件量。

Answer 3

GetJudgeCaseList <- function(CaseList, judgeList, casesAllowed, NumJudges) {
    e <- new.env()
    e$casesLeft <- data.frame(Judges = judgeList, itersLeft = casesAllowed)
    e$judgeList = judgeList
doCase <- function(i) {
pickJudges <- function(NumJudges, judgeList) {
  CurJudges <- sample(judgeList, NumJudges)
  return(CurJudges)
}
case <- pickJudges(NumJudges, e$judgeList)
e$casesLeft[casesLeft$Judges%in%case, 2] <-  e$casesLeft[casesLeft$Judges%in%case, 2]  - 1
e$judgeList <- e$casesLeft$Judges[e$casesLeft$itersLeft!=0]
return(data.frame(Case = CaseList[i], judges = paste0(case, collapse = ", ")))
}
Cases <- do.call(rbind, lapply(1:length(CaseList), doCase))
return(Cases)
}
GetJudgeCaseList(CaseList = c(1:22), judgeList = N, casesAllowed = 4, NumJudges = 3)

   Case  judges
1     1 a, h, o
2     2 k, i, j
3     3 j, q, a
4     4 j, n, p
5     5 g, o, n
6     6 q, g, l
7     7 g, d, i
8     8 b, l, f
9     9 m, b, i
10   10 k, m, c
11   11 l, m, p
12   12 m, o, q
13   13 p, g, b
14   14 p, f, b
15   15 l, e, i
16   16 d, h, o
17   17 d, c, q
18   18 a, f, e
19   19 e, d, c
20   20 e, n, k
21   21 a, k, f
22   22 j, n, c