Problem set: I have 3 different groups that need to be assigned to 6 different locations.
Objective: I need to minimize the unused space in each location.
Constraints:
For each location j, the sum of individuals assigned to that location from all groups should be less than or equal to the location capacity of j. (e.g. Each location has a capacity which cannot be exceeded.)
The total number of Group A, Group B, and Group C assigned to each location should not exceed the corresponding total numbers available. (e.g. Each group has a size that cannot be exceeded.)
The groups cannot mix. For example, Group A cannot be in the same camp as Group B or Group C, Group B cannot be in the same location as Group A or Group C, and so on.
The issue I am having is with the third constraint.
Below is the R script that works for the first two constraints:
library(lpSolve)
# Define the data
n_groups <- 3
n_locations <- 6
n_group_a <- 130
n_group_b <- 40
n_group_c <- 120
l_capacities <- c(60, 50, 40, 30, 20, 10)
# Define the decision variables
vars <- matrix(0, nrow = n_groups * n_locations, ncol = 1)
for (i in 1:n_groups) {
for (j in 1:n_locations) {
vars[(i-1)*n_locations+j] <- 1
}
}
# Maximize the used spaces
obj <- rep(1, n_locations*n_groups)
# Define the constraints
rhs <- c(l_capacities, n_group_a, n_group_b, n_group_c)
dir <- c(rep("<=", n_locations + n_groups))
con <- matrix(0, nrow = n_locations + n_groups, ncol = n_groups * n_locations)
# Constraint 1: For each location j, the sum of individuals assigned to that location from all groups should be less than or equal to the location capacity of j.
for (j in 1:n_locations) {
for (i in 1:n_groups) {
con[j, (i-1)*n_locations+j] <- 1
}
}
# Constraint 2: The total number of Group A, Group B, and Group C assigned to each location should not exceed the corresponding total numbers available.
for (j in 1:n_groups) {
con[n_locations+j, seq((j-1)*n_locations+1, j*n_locations)] <- c(rep(1, n_locations))#, rep(0, 5 * n_groups))
# con[n_locations+j, seq((j-1)*n_locations+1, j*n_locations)] <- c(rep(1, n_locations))#, rep(0, 5 * n_groups))
# con[n_locations+n_groups+j, seq((j-1)*n_groups+1, j*n_groups)] <- c(rep(1, n_groups)) #c(rep(0, n_groups), rep(1, n_groups), rep(0, n_groups))
# con[n_locations+2*n_groups+j, seq((j-1)*n_groups+1, j*n_groups)] <- c(rep(0, 2 * n_groups), rep(1, n_groups))
}
# Solve the problem
result <- lp(direction = "max", objective.in = obj, const.mat = con, const.dir = dir, const.rhs = rhs)
# Print the optimal assignment
assignment <- matrix(result$solution[1:(n_groups*n_locations)], nrow = n_locations)
rownames(assignment) <- paste0("Location ", 1:n_locations)
colnames(assignment) <- c("Group A", "Group B", "Group C")
print(assignment)
I am having difficulty building the third constraint. Below is the code I have been playing with but would like some help adjusting (currently gives me an "subscript out of bounds" error):
# Constraint 3: Each individual can only be assigned to one location.
# for (i in 1:n_groups) {
# con[n_locations+2*n_groups+i, seq((i-1)*n_locations+1, i*n_locations)] <- rep(1, n_locations)
# }
Any help appreciated. Thanks!
So after some rewriting of the script, the answer I was looking for is below. I point out where changes were made from the original and the addition of two new constraints. I realize that the script does not show if there is any unused space at a given location nor if there is any whole or part of a group that is unassigned to a given location (for example, all of Group B is never assigned to a location). I plan on adding those parts to the script later. Appreciate the comments and hope this is helpful to someone.
`library(lpSolve)
## Define the data
n_groups <- 3
n_locations <- 6
n_group_a <- 130
n_group_b <- 40
n_group_c <- 120
l_capacities <- c(60, 50, 40, 30, 20, 10)
# **CHANGED** REMOVED Define the decision variables
# vars <- matrix(0, nrow = n_groups * n_locations, ncol = 1)
#
# for (i in 1:n_groups) {
# for (j in 1:n_locations) {
# vars[(i-1)*n_locations+j] <- 1
# }
# }
# Maximize the used spaces
obj <- rep(1, n_locations*n_groups)
# **NEW** Add in additional space in objective function
obj <- c(obj, rep(0,n_groups*n_locations))
# **CHANGED** Define the constraints
#rhs <- c(l_capacities, n_group_a, n_group_b, n_group_c)
rhs <- c(l_capacities, n_group_a, n_group_b, n_group_c, rep(0,n_groups*n_locations), rep(1,n_locations))
# **CHANGED** Direction of the constraints which includes Constraint 3 & 4
#dir <- c(rep("<=", n_locations + n_groups))
dir <- c(rep("<",n_groups),rep("<",n_locations),rep("<",n_groups*n_locations), rep("=",n_locations))
## **CHANGED** Establish the constraint Mmatrix shell
#con <- matrix(0, nrow = n_locations + n_groups, ncol = n_groups * n_locations)
con <- matrix(0,nrow = n_locations+n_groups+n_groups*n_locations+n_locations, ncol=length(obj))
# Constraint 1: For each location j, the sum of individuals assigned to that location from all groups should be less than or equal to the location capacity of j.
for (j in 1:n_locations) {
for (i in 1:n_groups) {
con[j, (i-1)*n_locations+j] <- 1
}
}
# **CHANGED** Constraint 2: The total number of Group A, Group B, and Group C assigned to each location should not exceed the corresponding total numbers available.
# for (j in 1:n_groups) {
# con[n_locations+j, seq((j-1)*n_locations+1, j*n_locations)] <- c(rep(1, n_locations))#, rep(0, 5 * n_groups))
# }
for (i in 1:n_groups) {
for (j in 1:n_locations) {
con[n_locations+i, (i-1)*n_locations+j] <- 1
}
}
## Constraint 3: Build out the binary matrix and add in the U entries on the second half of the matrix
for (i in 1:(n_groups*n_locations)) {
con[n_locations+n_groups+i, i] <- 1
}
for (i in 1:(n_groups*n_locations)) {
con[n_locations+n_groups+i, (n_groups*n_locations)+i] <- U
}
## Constraint 4: Add in the population location constraint i.e. only one group per location.
for (j in 1:n_locations) {
for (i in 1:n_groups) {
con[n_locations*n_groups+n_groups+n_locations+j, (i-1)*n_locations+j+n_locations*n_groups] <- 1
}
}
# **CHANGED** Solve the problem
#result <- lp(direction = "max", objective.in = obj, const.mat = con, const.dir = dir, const.rhs = rhs)
result <- lp("max", obj, con, dir, rhs, int.vec=1:(n_groups*n_locations), binary.vec=(n_groups*n_locations+1):length(obj), compute.sens = 0)
# Print the optimal assignment
assignment <- matrix(result$solution[1:(n_groups*n_locations)], nrow = n_locations)
rownames(assignment) <- paste0("Location ", 1:n_locations)
colnames(assignment) <- c("Group A", "Group B", "Group C")
print(assignment)`