使用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