GA
GA copied to clipboard
Saving the population from each generation
Hello,
I'm wondering if there is a way to record the population (and their associated fitness) from each generation? As far as I can tell, one can only access the final population in the output of ga
. I am specifically interested in this in order to visualize the parameter space.
I have managed a way to do this with a custom monitoring function, but it requires that I write the population to a text file in the global environment. I think this is a big no-no when making a function (at least when the goal is to include the function in another package).
I was wondering if you know if any other more elegant ways of doing this. I thought of memoisation, but have been unable to access the cache.
Thanks in advance for your help. Below is an example of what I'm trying to do:
Example
library(GA)
Rastrigin <- function(x1, x2)
{
20 + x1^2 + x2^2 - 10*(cos(2*pi*x1) + cos(2*pi*x2))
}
gaMonitor2a <- function (object, digits = getOption("digits"), ...){
pop <- as.data.frame(object@population)
names(pop) <- paste0("par", seq(ncol(pop)))
pop$fitness <- object@fitness
pop$iter <- object@iter
if(object@iter == 1){
write.table(x = pop, file = "gaMonitorObj.csv", sep = ",", append = FALSE, row.names = FALSE, col.names = TRUE)
} else {
write.table(x = pop, file = "gaMonitorObj.csv", sep = ",", append = TRUE, row.names = FALSE, col.names = FALSE)
}
fitness <- na.exclude(object@fitness)
sumryStat <- c(mean(fitness), max(fitness))
sumryStat <- format(sumryStat, digits = digits)
cat(paste("GA | iter =", object@iter, "| Mean =",
sumryStat[1], "| Best =", sumryStat[2]))
cat("\n")
flush.console()
}
GA2a <- ga(type = "real-valued",
fitness = function(x) -Rastrigin(x[1], x[2]),
lower = c(-5.12, -5.12), upper = c(5.12, 5.12),
popSize = 50, maxiter = 100,
optim = TRUE, seed = 1,
monitor = gaMonitor2a ### custom monitor function
)
summary(GA2a)
# load and plot
pop <- read.csv(file = "gaMonitorObj.csv")
n <- 60
X <- akima::interp(x = pop$par1, y = pop$par2, z = pop$fitness, duplicate = TRUE, nx = n, ny = n)
pal <- colorRampPalette(c("#352A87", "#3439A8", "#214DC8", "#0E5FDB", "#056EDE", "#0F79D9",
"#1283D4", "#0D8FD1", "#089BCE", "#06A5C7", "#0BACBC", "#1CB1AE",
"#33B7A0", "#4EBB91", "#6DBE81", "#8ABE75", "#A3BD6A", "#BBBC60",
"#D1BA58", "#E6B94E", "#F9BD3F", "#FBC831", "#F8D626", "#F5E71A",
"#F9FB0E"))
image(X, col = pal(100))
points(par2 ~ par1, pop, pch = ".", col = adjustcolor(1,0.2))
The idea is pretty much ok, but I would
- save the info in an object in the global environment (or other you can define)
- use the argument
postFitness
to pass the function that save the info
Here is a version of your code that implements the approach:
library(GA)
Rastrigin <- function(x1, x2)
{
20 + x1^2 + x2^2 - 10*(cos(2*pi*x1) + cos(2*pi*x2))
}
postfit <- function(object, ...)
{
pop <- as.data.frame(object@population)
names(pop) <- paste0("par", seq(ncol(pop)))
pop$fitness <- object@fitness
pop$iter <- object@iter
# update info
if(!exists(".pop", envir = globalenv()))
assign(".pop", NULL, envir = globalenv())
.pop <- get(".pop", envir = globalenv())
assign(".pop", rbind(.pop, pop), envir = globalenv())
# output the input ga object (this is needed!)
object
}
GA <- ga(type = "real-valued",
fitness = function(x) -Rastrigin(x[1], x[2]),
lower = c(-5.12, -5.12), upper = c(5.12, 5.12),
popSize = 50, maxiter = 100, seed = 1,
postFitness = postfit)
str(.pop)
n <- 60
X <- akima::interp(x = .pop$par1, y = .pop$par2, z = .pop$fitness,
duplicate = TRUE, nx = n, ny = n)
pal <- colorRampPalette(c("#352A87", "#3439A8", "#214DC8", "#0E5FDB", "#056EDE", "#0F79D9",
"#1283D4", "#0D8FD1", "#089BCE", "#06A5C7", "#0BACBC", "#1CB1AE",
"#33B7A0", "#4EBB91", "#6DBE81", "#8ABE75", "#A3BD6A", "#BBBC60",
"#D1BA58", "#E6B94E", "#F9BD3F", "#FBC831", "#F8D626", "#F5E71A",
"#F9FB0E"))
image(X, col = pal(100))
points(par2 ~ par1, .pop, pch = ".", col = adjustcolor(1,0.2))
Fantastic - this is much faster than my approach, and not saving any objects. Thanks for your quick response!