unconference-scheduler.R

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