1 Knapsack problem

Determine items to include in a collection so that the total weight is less than or equal to a given limit and the total survival points is as large as possible

It is a Constrained Optimization problem

Maximize survivalpoints
subject to 
  totalweight < weightlimit

dataset <- data.frame(item = c("pocketknife", "beans", "potatoes", "unions", 
    "sleeping bag", "rope", "compass"), survivalpoints = c(10, 20, 15, 2, 30, 
    10, 30), weight = c(1, 5, 10, 1, 7, 5, 1))

dataset

##           item survivalpoints weight
## 1  pocketknife             10      1
## 2        beans             20      5
## 3     potatoes             15     10
## 4       unions              2      1
## 5 sleeping bag             30      7
## 6         rope             10      5
## 7      compass             30      1

# --------------- evaluation function ------------------

#  The evaluation function will evaluate the different individuals (chromosomes) of the population on the value of their gene configuration.

# The genalg algorithm tries to optimize towards the minimum value. Therefore, the value is calculated as above and multiplied with -1. 

weightlimit <- 20

evalFunc <- function(x) {
    current_solution_survivalpoints <- x %*% dataset$survivalpoints
    current_solution_weight <- x %*% dataset$weight

    if (current_solution_weight > weightlimit) 
        return(0) else return(-1*current_solution_survivalpoints)
}

# --------------- search iterations -----------------

library(genalg)


# size the number of genes in the chromosome.
# popSize the population size.
# iters the number of iterations.

iter = 100
GAmodel <- rbga.bin(size = 7, popSize = 200, iters = iter, mutationChance = 0.01, 
    elitism = T, evalFunc = evalFunc)

summary(GAmodel, echo=TRUE)

## GA Settings
##   Type                  = binary chromosome
##   Population size       = 200
##   Number of Generations = 100
##   Elitism               = TRUE
##   Mutation Chance       = 0.01
## 
## Search Domain
##   Var 1 = [,]
##   Var 0 = [,]
## 
## GA Results
##   Best Solution : 1 1 0 1 1 1 1

# -------------- display soluation -------------------

solution = c(1, 1, 0, 1, 1, 1, 1)
dataset[solution == 1, ]

##           item survivalpoints weight
## 1  pocketknife             10      1
## 2        beans             20      5
## 4       unions              2      1
## 5 sleeping bag             30      7
## 6         rope             10      5
## 7      compass             30      1

# solution vs available
cat(paste(solution %*% dataset$survivalpoints, "/", sum(dataset$survivalpoints)))

## 102 / 117

2 Visualize how the model evolves

# The blue line shows the mean solution of the entire population of that generation, while the red line shows the best solution of that generation. As you can see, it takes the model only a few generations to hit the best solution, after that it is just a matter of time until the mean of the population of subsequent generations evolves towards the best solution.

library(ggplot2)

animate_plot <- function(x) {
    for (i in seq(1, iter)) {
        temp <- data.frame(Generation = c(seq(1, i), seq(1, i)), Variable = c(rep("mean", i), rep("best", i)), Survivalpoints = c(-GAmodel$mean[1:i], -GAmodel$best[1:i]))
        pl <- ggplot(temp, aes(x = Generation, y = Survivalpoints, group = Variable, colour = Variable)) + geom_line() + scale_x_continuous(limits = c(0, iter)) + scale_y_continuous(limits = c(0, 110)) + geom_hline(yintercept = max(temp$Survivalpoints), lty = 2) + annotate("text", x = 1, y = max(temp$Survivalpoints) + 2, hjust = 0, size = 3, color = "black", label = paste("Best solution:", max(temp$Survivalpoints))) + scale_colour_brewer(palette = "Set1") + labs(title = "Evolution Knapsack optimization model")
        print(pl)
    }
}

# animate_plot()

# in order to save the animation
# library(animation)
# saveGIF(animate_plot(), interval = 0.1, outdir = getwd())

reference: https://www.r-bloggers.com/genetic-algorithms-a-simple-r-example/

Genetic Algorithm

1 Knapsack problem

2 Visualize how the model evolves