R中的遗传算法

Question

我有这样的问题：我需要找到不会超过最大重量的物品的最佳组合。对于这个问题，我使用了遗传算法。

这是我的数据

dataset <- data.frame(name = paste0("x",1:11),
                  Weight = c(2.14083022,7.32592911,0.50945094,4.94405846,12.02631340,14.59102403,0.07583312,0.36318323,10.64413370,3.54882187,1.79507759),
                  stringsAsFactors = F)

这是我的成本函数：

max_weight = 10
fitness_function <- function(x){
   current_weight <- x %*% dataset$Weight
          if ( current_weight > max_weight){
      return(0)
   } else {
      return( -1* current_weight)
   }
}

然后我尝试了两个包中的 ga：genalg 和 GA

通用

    ga_genalg <- rbga.bin(size = 11,
                          popSize = 100, 
                          mutationChance = .1,
                          evalFunc = fitness_function)

好的，这是结果：

cat(summary(ga_genalg))
GA Settings
  Type                  = binary chromosome
  Population size       = 100
  Number of Generations = 100
  Elitism               = 20
  Mutation Chance       = 0.1

Search Domain
  Var 1 = [,]
  Var 0 = [,]

GA Results
  Best Solution : 0 1 1 0 0 0 0 1 0 0 1

我检查了最佳解决方案，看起来不错：

genalg_best_solution = c(0,1,1,0,0,0,0,1,0,0,1)
dataset$Weight %*% genalg_best_solution 
         [,1]
[1,] 9.993641

PS。有人知道如何在不打字和不使用正则表达式的情况下获得最佳解决方案向量吗？

GA

ga_GA <- ga(type = "binary", fitness = fitness_function, popSize = 100, pmutation = .1, nBits = 11)
ga_best_solution = ga_GA@solution 
dim(ga_best_solution)
[1] 73 11

解是一个有 73 行的矩阵。还有ga_GA@bestSolreturnslist()

这个包中我最好的解决方案在哪里？或者我需要检查所有 73 行并找到最好的（我试过并得到 73 个零）？

PPS。第二题解法：GA最大化函数和genalg最小化函数=/. 有人知道如何从 genalg 包中提取最佳解决方案吗？

Answer 1

这里有很多问题。我的观点是 GA 可以为您提供更简单的输出：最佳解决方案和适应度分数。

你说得对，GA 最大化了适应度得分，而 genalg 最小化了 - 我创建了第二个适应度函数，它没有 return 适应度值乘以 -1。这导致两者的解决方案相同。

此外，我没有得到您为 ga() 的输出提供的维度。在我的例子中，这只是包含 11 个二进制值的单行：

library(GA)
library(genalg)

dataset <- data.frame(name = paste0("x",1:11),
  Weight = c(
    2.14083022,7.32592911,0.50945094,4.94405846,
    12.02631340,14.59102403,0.07583312,0.36318323,
    10.64413370,3.54882187,1.79507759
  ),
  stringsAsFactors = F
)

max_weight = 10


# genalg ------------------------------------------------------------------

# fitness function for genalg 
fitness_function <- function(x){
   current_weight <- x %*% dataset$Weight
   if ( current_weight > max_weight){
      return(0)
   } else {
      return(-current_weight)
   }
}


ga_genalg <- rbga.bin(size = 11,
  popSize = 100, 
  mutationChance = .1,
  evalFunc = fitness_function
)
tail(ga_genalg$best, 1) # best fitness
summary(ga_genalg, echo=TRUE)

plot(ga_genalg) # plot

# helper function from ?rbga.bin
monitor <- function(obj) {
    minEval = min(obj$evaluations);
    filter = obj$evaluations == minEval;
    bestObjectCount = sum(rep(1, obj$popSize)[filter]);
    # ok, deal with the situation that more than one object is best
    if (bestObjectCount > 1) {
        bestSolution = obj$population[filter,][1,];
    } else {
        bestSolution = obj$population[filter,];
    }
    outputBest = paste(obj$iter, " #selected=", sum(bestSolution),
                       " Best (Error=", minEval, "): ", sep="");
    for (var in 1:length(bestSolution)) {
        outputBest = paste(outputBest,
            bestSolution[var], " ",
            sep="");
    }
    outputBest = paste(outputBest, "\n", sep="");

    cat(outputBest);
}

monitor(ga_genalg)
# 100 #selected=4 Best (Error=-9.99364087): 0 1 1 0 0 0 0 1 0 0 1 



# GA ----------------------------------------------------------------------

# fitness function for GA (maximizes fitness)
fitness_function2 <- function(x){
   current_weight <- x %*% dataset$Weight
   if ( current_weight > max_weight){
      return(0)
   } else {
      return(current_weight)
   }
}

ga_GA <- ga(type = "binary", fitness = fitness_function2, popSize = 100, pmutation = .1, nBits = 11)
ga_GA@solution 
#     x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11
# [1,]  0  1  1  0  0  0  0  1  0   0   1
dim(ga_best_solution)
# [1]  1 11

ga_GA@fitnessValue
# [1] 9.993641

R中的遗传算法

Genetic Algorithm in R

r

algorithm

genetic-algorithm