I'll outline binary genetic algorithm approach using GA package interface that you can use as baseline to create your own implementation. Because you have constraint that you want subset of specific length I will create mutation and crossover operators that will not ruin that specification (otherwise those operators will mostly create infeasible individuals).
mutation
mutation <- function(obj, parent){
vec <- as.vector(obj@population[parent,])
ind1 <- which(vec == 1)
ind2 <- setdiff(seq_along(vec), ind1)
ind1 <- sample(ind1, 1)
ind2 <- sample(ind2, 1)
vec[c(sample(ind1, 1), sample(ind2, 1))] <- c(0, 1)
vec
}
Mutation picks one position with 1 and one position with 0 and change their values to 0 and 1 respectively.
crossover
sizeCrossover <- function(size){
function(obj, parents){
vec1 <- obj@population[parents[1],] == 1
vec2 <- obj@population[parents[2],] == 1
c1[sample(which(!c1), size - sum(c1))] <- 1
c2 <- vec1 | vec2
c2[sample(which(c2), sum(c2) - size)] <- 0
list(children = rbind(c1, c2), fitness = c(NA, NA))
}
}
Crossover is variation of arithmetic crossover. In case of & it needs to additionally change some 0 to 1 and in case of | it needs to additionally change some 1 to 0.
initial population
initialPopulation <- function(popSize, N, size){
indices <- do.call(
rbind,
mapply(
function(x, y) cbind(x, y),
seq_len(popSize),
replicate(popSize, sample(seq_len(N), size), simplify = FALSE),
SIMPLIFY = FALSE
)
)
mm <- matrix(0, nrow = popSize, ncol = N)
mm[indices] <- 1
mm
}
If you create completely random initial population most (if not every) individuals will be infeasible. You need to create feasible initial population.
fitness
fitness <- function(vec, m, size){
indices <- which(vec == 1)
-sum(m[indices,indices])
}
GA::ga performas maximization hence the minus sign.
random data and parameters
N <- 200 # matrix dimensions
size <- 10 # subset length
popSize <- 100 # population size for genetic algorithm
m <- matrix(sample(0:10, N^2, TRUE), nrow = N)
diag(m) <- 0
ga
obj <- GA::ga(
type = "binary",
nBits = N,
run = 500,
maxiter = 10000,
popSize = popSize,
fitness = fitness,
m = m,
size = 10,
suggestions = initialPopulation(popSize, N, size),
mutation = mutation,
crossover = sizeCrossover(size)
)
subset <- which(obj@solution[1,] == 1)
note
I'm using sample as modified in Advanced R:
sample <- function(x, size = NULL, replace = FALSE, prob = NULL) {
size <- size %||% length(x)
x[sample.int(length(x), size, replace = replace, prob = prob)]
}
