R库genalg中的遗传算法(rbga.bin)评估值错误

时间:2019-07-03 21:09:44

标签: r genetic-algorithm

我遇到了R库rbga.bin(版本0.2.0)中的genalg函数的问题。当我保存优化中的所有迭代并查看每个染色体的评估值时,我可以看到评估值通常是不正确的。

有人可以解释发生了什么事吗?

MWE:

# Setup
rm(list = ls())
library(genalg)
grid <- cbind(c(1.5,1.5,1.5,-1.5,0.5,1.5,0.5,-1.5,0.5,-1.5,-0.5,-1.5,-0.5,-0.5,0.5,-0.5),
              c(-0.5,-1.5,0.5,0.5,1.5,1.5,-1.5,1.5,-0.5,-0.5,0.5,-1.5,-1.5,1.5,0.5,-0.5))

# Objective function
evalFun <- function(i) {
  grid.sub <- grid[i == 1, ]
  if (sum(i) <= 1) {
    return(1000)
  }
  obj <- sum(grid.sub[, 1] - grid.sub[, 2])
}

# Save GA iterations to CSV file
monitor <- function(obj) {
  print(obj$evaluations)
  write.table(cbind(obj$population, obj$evaluations, rep(obj$iter, 150)),
              file = "output.csv",
              row.names = FALSE,
              col.names = FALSE,
              sep = ",",
              append = T)
}


# Run binary GA 
set.seed(23412)
if (file.exists("output.csv")) {file.remove("output.csv")}
GAmodel <- rbga.bin(size = nrow(grid), popSize = 100, iters = 20,
                    evalFunc = evalFun,
                    monitorFunc = monitor)

# Load monitored data
df <- read.csv(file = "output.csv", header = F)  # Read CSV file

# Define evaluation and genereation column
eval.col <- nrow(grid) + 1
gen.col <- nrow(grid) + 2

# Save GA evaluation values in e1
e1 <- df[, eval.col]
# Calculate evaluation value based on chromosome sequence and save in e2
e2 <- apply(df[, -c(eval.col, gen.col)], 1, evalFun)

# Print percent of evaluation values that match
# (Accept numerical deviations by using zapsmall)
print(paste(round(sum(zapsmall(e1 - e2) == 0) / nrow(df) * 100, 1), "% match"))

# Look at diverging evaluation values  
idx <- zapsmall(e1 - e2) != 0
head(e1[idx], 10)
head(e2[idx], 10)

0 个答案:

没有答案