This notebook is motivated by a question on OR Stack Exchange, asking about finding a maximum cut in an undirected graph subject to a “budget”. Specifically, given a graph \(G=(V,E)\) with vertex set \(V=\lbrace 1,\dots,N\rbrace\) and a “budget” \(b\in \lbrace 1,\dots,N-1\rbrace\), find the subset \(A\subset V\) which maximizes the size of the cut defined by \(A\) and \(B=V\backslash A\) (i.e., the number of edges \((i,j)\in E\) such that \(i\in A\) and \(j\in B\)) is maximal, subject to the requirement that \(|A|=b\). The question asks about heuristic methods to find a cut.
One possible heuristic that comes to mind is a genetic algorithm (GA) using a permutation of \(V\) as the chromosome, with the first \(b\) vertices in the permutation forming \(A\). To test it, we will generate a random graph, find an optimal cut by solving a mixed-integer linear program (MILP) using CPLEX, and then use a GA to find a “good” cut and see how good it is.
The first step is to load some libraries.
# Libraries used to set up and solve the MILP model.
library(ROI) # general solver interface
library(ROI.plugin.cplex) # connects the ROI package to CPLEX
library(ompr) # MIP modeling package
library(ompr.roi) # connects OMPR to ROI
# Library used to create and run a genetic algorithm.
library(GA)
# Library used for timing the GA.
library(tictoc)
# Library used to set a time limit.
library(R.utils)We need to set some parameters:
N <- 50
b <- 10
delta <- 0.35
seed <- 465
timeLimit <- 120 # secondsNext, we randomly create a test graph and a budget. The graph will be stored as a \(|E|\times 2\) matrix where each row denotes an edge and the columns are the lower and higher indexed nodes on the edge.
# Set the random seed.
set.seed(seed)
# Generate a matrix containing all edges.
edges <- combn(1:N, 2) |> t()
colnames(edges) <- c("lo", "hi")
# Sample the matrix randomly to get the edges included in the graph.
keep <- round(delta * nrow(edges)) # number of rows to keep
keep <- sample.int(nrow(edges), size = keep) # indices of rows to keep
edges <- edges[sort(keep), ] # retained edges
nEdges <- nrow(edges) # number of edges
rm(keep)We will need a function that computes the objective value given a choice of \(A\).
# Input: a vector containing the vertices in A.
# Output: the size of the corresponding cut.
cutSize <- function(x) {
sum(xor(edges[, "lo"] %in% x, edges[, "hi"] %in% x))
}We need a function to take a chromosome (permutation of the vertex numbers) and compute the size of the resulting cut.
# Input: a chromosome (permutation of 1,..., N)
# Output: the size of the cut obtained by defining A as the first b vertices in the permutation
cutFitness <- function(perm) {
cutSize(perm[1:b])
}We can now define an “island” GA with a permutation chromosome. We will use defaults for most of the parameters, but stopping after 200 generations with no improvement (with overall generation limit 10,000), using a mutation rate of 0.2 (twice the default), and with parallel computation of fitness values set to true. We also specify a random seed for reproducibility.
gaSeed <- seed
# Start timing.
tic("GA run time")
alg <- gaisl(type = "permutation", fitness = cutFitness, lower = 1, upper = N, maxiter = 10000, run = 200, parallel = TRUE, pmutation = 0.2, seed = gaSeed)Islands GA | epoch = 1
Mean = 139.32 | Best = 162.00
Mean = 139.32 | Best = 162.00
Mean = 139.32 | Best = 162.00
Mean = 139.32 | Best = 162.00
Islands GA | epoch = 2
Mean = 142.52 | Best = 162.00
Mean = 140.72 | Best = 162.00
Mean = 141.72 | Best = 164.00
Mean = 143.24 | Best = 162.00
Islands GA | epoch = 3
Mean = 143.44 | Best = 162.00
Mean = 143.16 | Best = 162.00
Mean = 140.60 | Best = 170.00
Mean = 136.92 | Best = 170.00
Islands GA | epoch = 4
Mean = 142.52 | Best = 170.00
Mean = 141.88 | Best = 162.00
Mean = 145.84 | Best = 170.00
Mean = 146.08 | Best = 170.00
Islands GA | epoch = 5
Mean = 141.92 | Best = 170.00
Mean = 142.24 | Best = 170.00
Mean = 141.44 | Best = 170.00
Mean = 143.32 | Best = 170.00
Islands GA | epoch = 6
Mean = 143.20 | Best = 170.00
Mean = 141.48 | Best = 170.00
Mean = 141.56 | Best = 170.00
Mean = 144.48 | Best = 170.00
Islands GA | epoch = 7
Mean = 144.20 | Best = 170.00
Mean = 144.52 | Best = 170.00
Mean = 141.76 | Best = 170.00
Mean = 146.40 | Best = 170.00
Islands GA | epoch = 8
Mean = 141.72 | Best = 170.00
Mean = 139.64 | Best = 170.00
Mean = 141.40 | Best = 170.00
Mean = 141.16 | Best = 170.00
Islands GA | epoch = 9
Mean = 142.88 | Best = 170.00
Mean = 143.00 | Best = 171.00
Mean = 142.56 | Best = 170.00
Mean = 146.12 | Best = 170.00
Islands GA | epoch = 10
Mean = 141.92 | Best = 170.00
Mean = 136.12 | Best = 171.00
Mean = 137.84 | Best = 171.00
Mean = 140.92 | Best = 170.00
Islands GA | epoch = 11
Mean = 138.76 | Best = 170.00
Mean = 144.44 | Best = 171.00
Mean = 137.92 | Best = 171.00
Mean = 140.32 | Best = 171.00
Islands GA | epoch = 12
Mean = 142.40 | Best = 171.00
Mean = 142.88 | Best = 171.00
Mean = 145.48 | Best = 171.00
Mean = 144.32 | Best = 171.00
Islands GA | epoch = 13
Mean = 140.64 | Best = 171.00
Mean = 142.44 | Best = 171.00
Mean = 142.36 | Best = 171.00
Mean = 145.80 | Best = 171.00
Islands GA | epoch = 14
Mean = 145.36 | Best = 171.00
Mean = 141.32 | Best = 171.00
Mean = 143.92 | Best = 171.00
Mean = 145.56 | Best = 171.00
Islands GA | epoch = 15
Mean = 140.72 | Best = 171.00
Mean = 142.80 | Best = 171.00
Mean = 144.88 | Best = 171.00
Mean = 140.92 | Best = 172.00
Islands GA | epoch = 16
Mean = 141.08 | Best = 172.00
Mean = 142.64 | Best = 171.00
Mean = 141.04 | Best = 171.00
Mean = 143.92 | Best = 172.00
Islands GA | epoch = 17
Mean = 142.16 | Best = 172.00
Mean = 143.56 | Best = 172.00
Mean = 142.28 | Best = 171.00
Mean = 140.64 | Best = 172.00
Islands GA | epoch = 18
Mean = 141.16 | Best = 172.00
Mean = 142.40 | Best = 172.00
Mean = 139.96 | Best = 172.00
Mean = 143.08 | Best = 172.00
Islands GA | epoch = 19
Mean = 144.84 | Best = 172.00
Mean = 144.96 | Best = 172.00
Mean = 143.92 | Best = 172.00
Mean = 145.72 | Best = 172.00
Islands GA | epoch = 20
Mean = 145.28 | Best = 172.00
Mean = 144.88 | Best = 172.00
Mean = 147.44 | Best = 172.00
Mean = 144.56 | Best = 172.00
Islands GA | epoch = 21
Mean = 141.40 | Best = 172.00
Mean = 139.20 | Best = 172.00
Mean = 140.96 | Best = 172.00
Mean = 142.60 | Best = 172.00
Islands GA | epoch = 22
Mean = 146.04 | Best = 172.00
Mean = 140.36 | Best = 172.00
Mean = 145.92 | Best = 172.00
Mean = 147.44 | Best = 172.00
Islands GA | epoch = 23
Mean = 143.08 | Best = 172.00
Mean = 140.08 | Best = 172.00
Mean = 143.40 | Best = 172.00
Mean = 144.20 | Best = 172.00
Islands GA | epoch = 24
Mean = 145.32 | Best = 172.00
Mean = 141.52 | Best = 172.00
Mean = 143.64 | Best = 175.00
Mean = 143.76 | Best = 172.00
Islands GA | epoch = 25
Mean = 144.00 | Best = 172.00
Mean = 146.04 | Best = 172.00
Mean = 142.28 | Best = 175.00
Mean = 140.64 | Best = 175.00
Islands GA | epoch = 26
Mean = 143.76 | Best = 175.00
Mean = 147.88 | Best = 172.00
Mean = 140.92 | Best = 175.00
Mean = 142.44 | Best = 175.00
Islands GA | epoch = 27
Mean = 142.16 | Best = 175.00
Mean = 145.20 | Best = 175.00
Mean = 143.60 | Best = 175.00
Mean = 145.40 | Best = 175.00
Islands GA | epoch = 28
Mean = 145.92 | Best = 175.00
Mean = 144.44 | Best = 175.00
Mean = 144.84 | Best = 175.00
Mean = 145.48 | Best = 175.00
Islands GA | epoch = 29
Mean = 145.68 | Best = 175.00
Mean = 143.28 | Best = 175.00
Mean = 141.76 | Best = 175.00
Mean = 144.88 | Best = 175.00
Islands GA | epoch = 30
Mean = 150.84 | Best = 175.00
Mean = 144.24 | Best = 177.00
Mean = 142.80 | Best = 175.00
Mean = 147.96 | Best = 175.00
Islands GA | epoch = 31
Mean = 145.44 | Best = 176.00
Mean = 145.40 | Best = 177.00
Mean = 143.56 | Best = 177.00
Mean = 143.92 | Best = 175.00
Islands GA | epoch = 32
Mean = 155.00 | Best = 176.00
Mean = 153.80 | Best = 177.00
Mean = 150.76 | Best = 177.00
Mean = 150.72 | Best = 177.00
Islands GA | epoch = 33
Mean = 143.92 | Best = 177.00
Mean = 144.00 | Best = 177.00
Mean = 146.52 | Best = 177.00
Mean = 146.68 | Best = 177.00
Islands GA | epoch = 34
Mean = 146.48 | Best = 177.00
Mean = 147.76 | Best = 177.00
Mean = 143.44 | Best = 177.00
Mean = 144.56 | Best = 177.00
Islands GA | epoch = 35
Mean = 144.28 | Best = 177.00
Mean = 147.04 | Best = 177.00
Mean = 148.76 | Best = 177.00
Mean = 145.08 | Best = 177.00
Islands GA | epoch = 36
Mean = 142.44 | Best = 177.00
Mean = 144.60 | Best = 177.00
Mean = 144.44 | Best = 177.00
Mean = 142.96 | Best = 177.00
Islands GA | epoch = 37
Mean = 141.24 | Best = 177.00
Mean = 144.56 | Best = 177.00
Mean = 145.52 | Best = 177.00
Mean = 143.40 | Best = 177.00
Islands GA | epoch = 38
Mean = 144.96 | Best = 177.00
Mean = 140.52 | Best = 177.00
Mean = 144.00 | Best = 177.00
Mean = 143.12 | Best = 177.00
Islands GA | epoch = 39
Mean = 143.36 | Best = 177.00
Mean = 142.56 | Best = 177.00
Mean = 144.36 | Best = 177.00
Mean = 145.60 | Best = 177.00
Islands GA | epoch = 40
Mean = 146.28 | Best = 177.00
Mean = 144.96 | Best = 177.00
Mean = 142.08 | Best = 177.00
Mean = 146.72 | Best = 177.00
Islands GA | epoch = 41
Mean = 141.12 | Best = 177.00
Mean = 140.32 | Best = 177.00
Mean = 143.52 | Best = 177.00
Mean = 142.68 | Best = 177.00
Islands GA | epoch = 42
Mean = 142.92 | Best = 177.00
Mean = 141.84 | Best = 177.00
Mean = 140.48 | Best = 177.00
Mean = 142.28 | Best = 177.00
Islands GA | epoch = 43
Mean = 140.72 | Best = 177.00
Mean = 144.40 | Best = 177.00
Mean = 144.80 | Best = 177.00
Mean = 141.72 | Best = 177.00
Islands GA | epoch = 44
Mean = 142.64 | Best = 177.00
Mean = 145.76 | Best = 177.00
Mean = 143.52 | Best = 177.00
Mean = 140.00 | Best = 177.00
Islands GA | epoch = 45
Mean = 145.52 | Best = 177.00
Mean = 142.28 | Best = 177.00
Mean = 144.76 | Best = 177.00
Mean = 143.68 | Best = 177.00
Islands GA | epoch = 46
Mean = 142.92 | Best = 177.00
Mean = 147.48 | Best = 177.00
Mean = 146.36 | Best = 177.00
Mean = 147.72 | Best = 177.00
Islands GA | epoch = 47
Mean = 143.40 | Best = 177.00
Mean = 143.04 | Best = 177.00
Mean = 146.00 | Best = 177.00
Mean = 144.76 | Best = 178.00
Islands GA | epoch = 48
Mean = 138.56 | Best = 178.00
Mean = 139.36 | Best = 177.00
Mean = 142.08 | Best = 177.00
Mean = 142.92 | Best = 178.00
Islands GA | epoch = 49
Mean = 146.16 | Best = 178.00
Mean = 146.16 | Best = 178.00
Mean = 146.36 | Best = 177.00
Mean = 144.48 | Best = 178.00
Islands GA | epoch = 50
Mean = 144.68 | Best = 178.00
Mean = 145.32 | Best = 178.00
Mean = 144.12 | Best = 178.00
Mean = 144.48 | Best = 178.00
Islands GA | epoch = 51
Mean = 144.88 | Best = 178.00
Mean = 145.44 | Best = 178.00
Mean = 146.76 | Best = 178.00
Mean = 142.96 | Best = 178.00
Islands GA | epoch = 52
Mean = 143.84 | Best = 178.00
Mean = 140.84 | Best = 178.00
Mean = 144.88 | Best = 178.00
Mean = 147.12 | Best = 178.00
Islands GA | epoch = 53
Mean = 142.92 | Best = 178.00
Mean = 143.96 | Best = 178.00
Mean = 146.80 | Best = 178.00
Mean = 142.84 | Best = 178.00
Islands GA | epoch = 54
Mean = 140.32 | Best = 178.00
Mean = 145.36 | Best = 178.00
Mean = 145.48 | Best = 178.00
Mean = 143.20 | Best = 178.00
Islands GA | epoch = 55
Mean = 143.08 | Best = 178.00
Mean = 142.56 | Best = 178.00
Mean = 146.80 | Best = 178.00
Mean = 141.40 | Best = 178.00
Islands GA | epoch = 56
Mean = 146.36 | Best = 178.00
Mean = 146.40 | Best = 178.00
Mean = 149.44 | Best = 178.00
Mean = 146.80 | Best = 178.00
Islands GA | epoch = 57
Mean = 144.56 | Best = 178.00
Mean = 144.76 | Best = 178.00
Mean = 147.52 | Best = 178.00
Mean = 146.24 | Best = 178.00
Islands GA | epoch = 58
Mean = 146.92 | Best = 178.00
Mean = 145.76 | Best = 178.00
Mean = 144.40 | Best = 178.00
Mean = 149.16 | Best = 178.00
Islands GA | epoch = 59
Mean = 149.52 | Best = 178.00
Mean = 146.56 | Best = 178.00
Mean = 148.24 | Best = 178.00
Mean = 148.72 | Best = 178.00
Islands GA | epoch = 60
Mean = 143.16 | Best = 178.00
Mean = 143.72 | Best = 178.00
Mean = 143.24 | Best = 178.00
Mean = 145.84 | Best = 178.00
Islands GA | epoch = 61
Mean = 144.56 | Best = 178.00
Mean = 146.80 | Best = 178.00
Mean = 145.32 | Best = 178.00
Mean = 144.84 | Best = 178.00
Islands GA | epoch = 62
Mean = 145.60 | Best = 178.00
Mean = 146.00 | Best = 178.00
Mean = 145.92 | Best = 178.00
Mean = 144.88 | Best = 178.00
Islands GA | epoch = 63
Mean = 143.92 | Best = 178.00
Mean = 142.72 | Best = 178.00
Mean = 143.80 | Best = 178.00
Mean = 143.84 | Best = 178.00
Islands GA | epoch = 64
Mean = 142.56 | Best = 178.00
Mean = 146.96 | Best = 178.00
Mean = 142.04 | Best = 178.00
Mean = 141.32 | Best = 178.00
Islands GA | epoch = 65
Mean = 142.40 | Best = 178.00
Mean = 142.00 | Best = 178.00
Mean = 145.52 | Best = 178.00
Mean = 146.12 | Best = 178.00
Islands GA | epoch = 66
Mean = 143.80 | Best = 178.00
Mean = 146.44 | Best = 178.00
Mean = 146.28 | Best = 178.00
Mean = 143.60 | Best = 178.00
Islands GA | epoch = 67
Mean = 139.88 | Best = 178.00
Mean = 142.64 | Best = 178.00
Mean = 143.56 | Best = 178.00
Mean = 142.32 | Best = 178.00
Islands GA | epoch = 68
Mean = 146.52 | Best = 178.00
Mean = 143.64 | Best = 178.00
Mean = 144.08 | Best = 178.00
Mean = 146.00 | Best = 178.00
Islands GA | epoch = 69
Mean = 141.04 | Best = 178.00
Mean = 146.16 | Best = 178.00
Mean = 144.40 | Best = 178.00
Mean = 141.32 | Best = 178.00
Islands GA | epoch = 70
Mean = 144.44 | Best = 178.00
Mean = 140.64 | Best = 178.00
Mean = 140.60 | Best = 178.00
Mean = 145.36 | Best = 178.00 toc()GA run time: 9.344 sec elapsed# Record and display the results.
gaValue <- alg@fitnessValue
gaIncumbent <- sort(alg@solution[1, 1:b])
cat("The best cut achieved has size = ", gaValue, "\n")The best cut achieved has size = 178 cat("A = ", gaIncumbent)A = 4 9 13 14 17 30 38 46 48 50For comparison with the swap heuristic, we will try running the GA with random restarts and a fixed time limit.
# We will use a copy of the random seed, modifying it for each successive run.
gaSeed <- seed
tic("Repeated GA")
withTimeout(
{
# Loop until time runs out.
while (TRUE) {
# Increment the seed.
gaSeed <- gaSeed + 1
# Run an island GA.
alg <- gaisl(type = "permutation", fitness = cutFitness, lower = 1, upper = N, maxiter = 10000, run = 200, parallel = TRUE, pmutation = 0.2, seed = gaSeed, monitor = FALSE)
# Check for a new incumbent.
if (alg@fitnessValue > gaValue) {
gaValue <- alg@fitnessValue
gaIncumbent <- sort(alg@solution[1, 1:b])
}
}
# In case the last GA run was interrupted, check for a new incumbent.
if (alg@fitnessValue > gaValue) {
gaValue <- alg@fitnessValue
gaIncumbent <- sort(alg@solution[1, 1:b])
}
},
timeout = timeLimit, cpu = Inf, onTimeout = "silent")NULLtoc()Repeated GA: 120.186 sec elapsedcat("GA incumbent value = ", gaValue, "\n")GA incumbent value = 178 cat("GA solution for A = ", gaIncumbent, "\n")GA solution for A = 4 9 13 14 17 30 38 46 48 50 Next, we will test a simple heuristic that generates a random choice of \(A\), then considers pairwise swaps of a vertex in \(A\) with a vertex in \(B\), accepting the swaps that improve the objective function. If no swap causes any improvement and a predefined time limit has not been reached, we restart with a new random \(A\).
# We need to track the incumbent objective value and the incumbent choice of $A$.
swapIncumbent <- NA
swapValue <- 0
# We reset the random seed for reproducibility.
set.seed(seed)
# Run the heuristic with the given time limit.
withTimeout(
{
# Loop until time runs out.
while (TRUE) {
# Generate a new random choice of A.
A <- sample(1:N, b)
# Test whether it is a new incumbent.
aValue <- cutSize(A)
if (aValue > swapValue) {
swapValue <- aValue
swapIncumbent <- A
}
# Set a flag to try swapping.
trySwapping <- TRUE
# Loop until a full pass occurs with no successful swaps.
while (trySwapping) {
trySwapping <- FALSE
restart <- FALSE
for (i in A) {
for (j in setdiff(1:N, A)) {
# Swap j for i.
temp <- c(setdiff(A, i), j)
# Compute the objective value.
z <- cutSize(temp);
# If it is an improvement, accept it.
if (z > aValue) {
A <- temp
aValue <- z
# Check for a new incumbent.
if (z > swapValue) {
swapValue <- z
swapIncumbent <- temp
}
# A successful swap means we break out of the for loops and continue looking for swaps.
trySwapping <- TRUE
restart <- TRUE
break # exits the inner for loop
}
}
if (restart) break # breaks out of the outer for loop
}
}
}
},
timeout = timeLimit, cpu = Inf, onTimeout = "silent")NULLcat("Heuristic incumbent value = ", swapValue, "\n")Heuristic incumbent value = 181 cat("Heuristic solution for A = ", swapIncumbent, "\n")Heuristic solution for A = 4 50 44 13 14 34 17 30 48 43 The MILP model uses a 0-1 variable (\(x\)) for each node (1 if the node belongs to \(A\), 0 if not) and a continuous variable (\(y\)) with domain \([0,1]\) for each edge (1 if the edge is part of the cut, 0 if not).
# Initialize the model.
mip <- MILPModel() |>
# Add the variables.
add_variable(x.var[i], i = 1:N, type = "binary") |>
add_variable(y.var[i], i = 1:nEdges, type = "continuous", lb = 0, ub = 1) |>
# Set the objective function.
set_objective(sum_expr(y.var[i], i = 1:nEdges), sense = "max") |>
# Add the budget constraint.
add_constraint(sum_expr(x.var[i], i = 1:N) == b)
# For each edge, add two constraints connecting the y variable for that edge to the x variables for its two endpoints.
for (i in 1:nEdges) {
lo <- edges[i, "lo"]
hi <- edges[i, "hi"]
mip <- mip |>
add_constraint(y.var[i] - x.var[lo] - x.var[hi] <= 0) |>
add_constraint(y.var[i] + x.var[lo] + x.var[hi] <= 2)
}
tic("CPLEX run time")
# Solve the model.
solution <- mip |> solve_model(with_ROI(solver = "cplex"))CPLEX environment opened
Closed CPLEX environmenttoc()CPLEX run time: 3.167 sec elapsed# Get the objective value (cut size).
cat("The optimal cut size = ", solution$objective_value, "\n")The optimal cut size = 181 # Recover the choice of A.
temp <- (solution |> get_solution(x.var[j]))[, "value"]
A <- which(temp > 0.5)
rm(temp, lo, hi)
cat("The optimal choice for A = ", A, "\n")The optimal choice for A = 4 12 13 14 30 38 43 44 48 50