luca-scr / GA

An R package for optimization using genetic algorithms
http://luca-scr.github.io/GA/
91 stars 29 forks source link

Saving the population from each generation #49

Open marchtaylor opened 3 years ago

marchtaylor commented 3 years ago

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))

grafik

luca-scr commented 3 years ago

The idea is pretty much ok, but I would 1) save the info in an object in the global environment (or other you can define) 2) 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))
marchtaylor commented 3 years ago

Fantastic - this is much faster than my approach, and not saving any objects. Thanks for your quick response!