Try our new documentation site (beta).
Filter Content By
Version
Text Search
${sidebar_list_label} - Back
Filter by Language
workforce2.R
# Copyright 2023, Gurobi Optimization, LLC # # Assign workers to shifts; each worker may or may not be available on a # particular day. If the problem cannot be solved, use IIS iteratively to # find all conflicting constraints. library(Matrix) library(gurobi) # Function to display results printsolution <- function(result) { if(result$status == 'OPTIMAL') { cat('The optimal objective is',result$objval,'\n') cat('Schedule:\n') for (s in 1:nShifts) { cat('\t',Shifts[s],':') for (w in 1:nWorkers) { if (result$x[varIdx(w,s)] > 0.9) cat(Workers[w],' ') } cat('\n') } } } # define data nShifts <- 14 nWorkers <- 7 nVars <- nShifts * nWorkers varIdx <- function(w,s) {s+(w-1)*nShifts} Shifts <- c('Mon1', 'Tue2', 'Wed3', 'Thu4', 'Fri5', 'Sat6', 'Sun7', 'Mon8', 'Tue9', 'Wed10', 'Thu11', 'Fri12', 'Sat13', 'Sun14') Workers <- c( 'Amy', 'Bob', 'Cathy', 'Dan', 'Ed', 'Fred', 'Gu' ) pay <- c(10, 12, 10, 8, 8, 9, 11 ) shiftRequirements <- c(3, 2, 4, 4, 5, 6, 5, 2, 2, 3, 4, 6, 7, 5 ) availability <- list( c( 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1 ), c( 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0 ), c( 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1 ), c( 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1 ), c( 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 1, 1 ), c( 1, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1 ), c( 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ) ) # Set up parameters params <- list() params$logfile <- 'workforce2.log' # Build model model <- list() model$modelname <- 'workforce2' model$modelsense <- 'min' # Initialize assignment decision variables: # x[w][s] == 1 if worker w is assigned # to shift s. Since an assignment model always produces integer # solutions, we use continuous variables and solve as an LP. model$lb <- 0 model$ub <- rep(1, nVars) model$obj <- rep(0, nVars) model$varnames <- rep('',nVars) for (w in 1:nWorkers) { for (s in 1:nShifts) { model$varnames[varIdx(w,s)] = paste0(Workers[w],'.',Shifts[s]) model$obj[varIdx(w,s)] = pay[w] if (availability[[w]][s] == 0) model$ub[varIdx(w,s)] = 0 } } # Set up shift-requirements constraints model$A <- spMatrix(nShifts,nVars, i = c(mapply(rep,1:nShifts,nWorkers)), j = mapply(varIdx,1:nWorkers, mapply(rep,1:nShifts,nWorkers)), x = rep(1,nShifts * nWorkers)) model$sense <- rep('=',nShifts) model$rhs <- shiftRequirements model$constrnames <- Shifts # Save model gurobi_write(model,'workforce2.lp', params) # Optimize result <- gurobi(model, params = params) # Display results if (result$status == 'OPTIMAL') { # The code may enter here if you change some of the data... otherwise # this will never be executed. printsolution(result); } else if (result$status == 'INFEASIBLE') { # We will loop until we reduce a model that can be solved numremoved <- 0 while(result$status == 'INFEASIBLE') { iis <- gurobi_iis(model, params = params) keep <- (!iis$Arows) cat('Removing rows',model$constrnames[iis$Arows],'...\n') model$A <- model$A[keep,,drop = FALSE] model$sense <- model$sense[keep] model$rhs <- model$rhs[keep] model$constrnames <- model$constrnames[keep] numremoved <- numremoved + 1 gurobi_write(model, paste0('workforce2-',numremoved,'.lp'), params) result <- gurobi(model, params = params) } printsolution(result) rm(iis) } else { # Just to handle user interruptions or other problems cat('Unexpected status',result$status,'\nEnding now\n') } #Clear space rm(model, params, availability, Shifts, Workers, pay, shiftRequirements, result)