Created
November 5, 2018 11:32
-
-
Save nacnudus/31f0332c1ae7781a1e74567865b899cc to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(tidyverse) | |
library(ompr) | |
library(ompr.roi) | |
library(ROI.plugin.glpk) | |
M <- 3 # Volunteers (rows) | |
N <- 4 # Jobs (combination of role at given time and location) (columnss) | |
# Jobs are: | |
# 1. Greet (8am-9am) | |
# 2. Session A (9am-10am) | |
# 3. Session B (9am-11am) | |
# 4. Farewell (11am-12noon) | |
# Volunteer/Job assignments (objective) | |
# X <- matrix(0L, nrow = M, ncol = N) | |
# Job/Job co-occurence (symmetrical, only the upper diagonal is used in the | |
# constraint) | |
Ca <- matrix(c(1L, 1L, 1L, 1L, | |
1L, 1L, 1L, 1L, | |
1L, 1L, 1L, 1L, | |
1L, 1L, 1L, 1L), | |
nrow = N, ncol = N, byrow = TRUE) | |
# Volunteer/Job availability | |
Cb <- matrix(c(1L, 1L, 1L, 1L, | |
1L, 1L, 1L, 1L, | |
0L, 1L, 1L, 0L), # Can't greet, can't do Farewell | |
nrow = M, ncol = N, byrow = TRUE) | |
# Job length | |
cc <- matrix(c(1L, | |
1L, | |
2L, | |
1L), | |
nrow = N, ncol = 1L, byrow = TRUE) | |
# Volunteer max volunteering time | |
cd <- matrix(c(2L, | |
3L, | |
3L), | |
nrow = M, ncol = 1L, byrow = TRUE) | |
# Whether a job is a session | |
ce <- matrix(c(0L, | |
1L, | |
1L, | |
0L), | |
nrow = N, ncol = 1L, byrow = TRUE) | |
# Volunteer max sessions | |
cf <- matrix(c(1L, | |
1L, | |
1L), | |
nrow = M, ncol = 1L, byrow = TRUE) | |
# Volunteer max jobs | |
cg <- matrix(c(2L, | |
1L, | |
2L), | |
nrow = M, ncol = 1L, byrow = TRUE) | |
solution <- | |
MIPModel() %>% | |
add_variable(X[i, j], | |
i = 1:M, j = 1:N, | |
type = "integer") %>% | |
set_bounds(X[i, j], | |
lb = 0L, ub = 1L, | |
i = 1:M, j = 1:N) %>% | |
# Each job (j) is done by 1 or 0 people (i) | |
add_constraint(sum_expr(X[i, j], i = 1:M) <= 1, | |
j = 1:N) %>% | |
# People only do certain jobs | |
add_constraint(X[i, j] <= Cb[i, j], | |
i = 1:M, j = 1:N) %>% | |
# Jobs are only done by the same person if that's allowed. | |
add_constraint(X[i, j] + X[i, j.] <= 1 + Ca[j, j.], | |
i = 1:M, j = 1:N, j. = 1:N, | |
# j. >= j because this constraint is symmetrical so the bottom | |
# triangle of the matrix can be ignored. | |
j. >= j) %>% | |
# People only do a certain number of jobs (concurrent jobs all count) | |
add_constraint(sum_expr(X[i, j], j = 1:N) <= cg[i], i = 1:M) %>% | |
# People only spend a certain amount of time doing jobs (two one-hour jobs done | |
# together count as two hours of work) | |
add_constraint(sum_expr(X[i, j] * cc[j], j = 1:N) <= cd[i], i = 1:M) %>% | |
# People only do a certain number of sessions | |
add_constraint(sum_expr(X[i, j] * ce[j], j = 1:N) <= cf[i], i = 1:M) %>% | |
# Maximise the number of jobs done. | |
set_objective(sum_expr(X[i, j], i = 1:M, j = 1:N), sense = "max") %>% | |
# extract_constraints() | |
solve_model(with_ROI("glpk")) | |
solution %>% | |
get_solution(X[i, j]) %>% | |
arrange(i, j) %>% | |
{matrix(.$value, nrow = M, byrow = TRUE)} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment