Генетический алгоритм в 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) 
    } 
} 

Тогда я попробовал га из двух пакетов: genalg и GA

genalg

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(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@bestSollist()

Где мое лучшее решение в этом пакете? Или мне нужно проверить все 73 строки и найти лучшее (я пробовал и получил 73 нулей)?

PPS. Второе решение вопроса: GA максимизирует функцию и genalg минимизирует функцию = /. Кто-нибудь знает, как извлечь лучшее решение из пакета genalg?

Answer 1

Здесь много вопросов. Мое мнение состоит в том, что GA обеспечивает более легкий выход для того, что вы хотите: лучшее решение и оценка пригодности.

Вы правы, что GA максимизировал показатель пригодности, в то время как genalg минимизирует - я создал вторую функцию фитнеса, которая не возвращает значение пригодности, умноженное на -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