Неправильные значения оценки из генетического алгоритма (rbga.bin) в библиотеке R, genalg - PullRequest
0 голосов
/ 04 июля 2019

У меня возникла проблема с функцией rbga.bin из библиотеки R, genalg (версия 0.2.0).Когда я сохраняю все итерации из оптимизации и смотрю оценочные значения для каждой из хромосом, я вижу, что оценочные значения часто не верны.

Может кто-нибудь объяснить, что происходит?

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)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...