Using lpSolve to optimize choices

Question

I am trying to use lpSolve to assign students to groups. Each student has ranked their interested in the group from first (most interest) to third (least interest). Students are listed as rows and their preferences as columns:

desires <- matrix(c(1,2,3,1,2,3,3,1,2,3,2,1,1,3,2),ncol=3,byrow=T)

If I use the following script:

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

I get the following result:

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

My problem is that group 1, column 1, has three members while the other groups only have one. How can I constrain the optimization so that each group as 1-2 members and each student is assigned to only one group? Thanks.

Answer 1

The row constraints should be = rather than >= . Also, add a second set of column constraints that each sum to 2 or less.

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

giving:

> 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