Assignment Problem in R - Deterministic vs. Stochastic

assignment_problem.R

library(tidyverse)
library(Rglpk)
library(glue)

df <- read_csv("data_assignment_regular.csv")
df_with_variability <- read_csv("data_assignment_with_variability.csv")

# Helper Functions ####
SolverLP <- function(model, method = "CPLEX_LP", decimal = 0) {
  model1.lp <- Rglpk_read_file(model, type = method, verbose = F)
  model1.lp.sol <- Rglpk_solve_LP(model1.lp$objective, 
                                  model1.lp$constraints[[1]],
                                  model1.lp$constraints[[2]], 
                                  model1.lp$constraints[[3]],
                                  model1.lp$bounds,
                                  model1.lp$types, 
                                  model1.lp$maximum)
  library(xtable)
  
  model1.lp.sol.df <- as.data.frame(model1.lp.sol$solution)
  model1.lp.sol.df <- rbind(model1.lp.sol.df, c(model1.lp.sol$optimum))
  
  rownames(model1.lp.sol.df) <- c(attr(model1.lp, "objective_vars_names"), "obj")
  colnames(model1.lp.sol.df) <- "Solution"
  table.sol <- knitr::kable(model1.lp.sol.df, digits = decimal)
  results <- list(sol = model1.lp.sol, df = model1.lp.sol.df, latex = table.sol)
  
  return(results)
}
normVarNames <- function(vars, sep = "_") {
  if (sep == ".") sep <- "\\."
  
  # Replace all _ and . and ' ' with the nominated separator. Note
  # that I used [] originally but that fails so use |.
  
  pat  <- '_|\u00a0|\u2022| |,|-|:|/|&|\\.|\\?|\\[|\\]|\\{|\\}|\\(|\\)'
  rep  <- sep
  vars <- gsub(pat, rep, vars)
  
  # Replace any all capitals words with Initial capitals. This uses an
  # extended perl regular expression. The ?<! is a zero-width negative
  # look-behind assertion that matches any occurrence of the following
  # pattern that does not follow a Unicode property (the \p) of a
  # letter (L) limited to uppercase (u). Not quite sure of the
  # use-case for the look-behind.
  
  pat  <- '(?<!\\p{Lu})(\\p{Lu})(\\p{Lu}*)'
  rep  <- '\\1\\L\\2'
  vars <- gsub(pat, rep, vars, perl=TRUE)
  
  # Replace any capitals not at the beginning of the string with _ 
  # and then the lowercase letter.
  
  pat  <- '(?<!^)(\\p{Lu})'
  rep  <- paste0(sep, '\\L\\1')
  vars <- gsub(pat, rep, vars, perl=TRUE)
  
  # WHY DO THIS? Replace any number sequences not preceded by an
  # underscore, with it preceded by an underscore. The (?<!...) is a
  # lookbehind operator.
  
  pat  <- paste0('(?<![', sep, '\\p{N}])(\\p{N}+)')
  rep  <- paste0(sep, '\\1')
  vars <- gsub(pat, rep, vars, perl=TRUE)
  
  # Remove any resulting initial or trailing underscore or multiples:
  #
  # _2level -> 2level
  
  vars <- gsub("^_+", "", vars)
  vars <- gsub("_+$", "", vars)
  vars <- gsub("__+", "_", vars)
  
  # Convert to lowercase
  
  vars <- tolower(vars)
  
  # Remove repeated separators.
  
  pat  <- paste0(sep, "+")
  rep  <- sep
  vars <- gsub(pat, rep, vars)
  
  return(vars)
}

# Reading Data ####
# Expects "Agent" in first column with "Tasks" in the remainder.
df <- read_excel("assign_problem.xlsx")
names(df) <- normVarNames(names(df))

agents <- df[[1]]
tasks <- names(df)[-1]
num_agents <- length(agents)
num_tasks <- length(tasks)

cost_vars <- unlist(df[, -1])
x_vars <- sapply(tasks, function(t) paste0(agents, "_", t))
cost_function <- paste0(cost_vars, x_vars, collapse = " + ")

agent_constraints <- as.data.frame(x_vars) %>% 
  unite("agent_constraints", 1:num_tasks, sep = " + ") %>%
  glue_data("{agents} : {agent_constraints} <= 1")

task_constraints <- as.data.frame(t(x_vars)) %>% 
  unite("task_constraints", 1:num_agents, sep = " + ") %>%
  glue_data("{tasks} : {task_constraints} = 1")

cat("Minimize",
    paste0("  Cost : ", cost_function), 
    "Subject To",
    paste0("  ", agent_constraints),
    paste0("  ", task_constraints),
    "Binary",
    paste0("  ", as.vector(x_vars), collapse = "\n"),
    "End",
    file = "cplex_model.txt", 
    sep = "\n")

model <- SolverLP("cplex_model.txt")

model

data_assignment_regular.csv

data_assignment_with_variability.csv