r - 使用 lpSolve 优化选择

Question

我正在尝试使用 lpSolve 将学生分配到组。每个学生将他们对小组的兴趣从第一(最感兴趣)到第三(最不感兴趣)进行排名。学生被列为行，他们的偏好被列为列:
desires <- matrix(c(1,2,3,1,2,3,3,1,2,3,2,1,1,3,2),ncol=3,byrow=T)
如果我使用以下脚本:

nr <- nrow(desires)
nc <- ncol(desires)
columns <- t(sapply(1:nc,function(x) rep(c(0,1,0),c(nr*(x-1),nr,nr*(nc-x)))))
rows <- t(sapply(1:nr, function(x) rep(rep(c(0, 1, 0), c(x-1, 1, nr-x)), nc)))
mod <- lp("min", as.vector(desires), rbind(columns, rows), ">=", rep(1, nr+nc), binary.vec=rep(TRUE, nr*nc))

我得到以下结果:

matrix(mod$solution,ncol=nc)

     [,1] [,2] [,3]
[1,]    1    0    0
[2,]    1    0    0
[3,]    0    1    0
[4,]    0    0    1
[5,]    1    0    0

我的问题是第 1 组第 1 列有三个成员，而其他组只有一个。如何限制优化，使每个组为 1-2 名成员，每个学生仅分配到一个组？谢谢。

Answer 1

行约束应该是 = 而不是 >= 。此外，添加第二组列约束，每个列约束的总和等于或小于 2。

# same rows and columns matrices as in question but code is shorter
rows <- t(rep(1, nc)) %x% diag(nr)
columns <-  diag(nc) %x% t(rep(1, nr))

L <- list(columns, rows, columns)
nrs <- sapply(L, nrow)

mod <- lp(direction = "min", 
          objective.in = as.vector(desires), 
          const.mat = do.call("rbind", L),
          const.dir = rep(c(">=", "=", "<="), nrs),
          const.rhs = rep(c(1, 1, 2), nrs),
          all.bin = TRUE)

给予:

> matrix(mod$solution, nr)
     [,1] [,2] [,3]
[1,]    0    1    0
[2,]    1    0    0
[3,]    0    1    0
[4,]    0    0    1
[5,]    1    0    0