GenSA и SA дают бессмысленный вывод для задачи о ранце

Question

У меня есть следующий CSV-файл:

Knapsack.CSV

,gewichten(gr),waarde
Voorwerp 1,70,135
Voorwerp 2,73,139
Voorwerp 3,77,149
Voorwerp 4,80,150
Voorwerp 5,82,156
Voorwerp 6,87,163
Voorwerp 7,90,173
Voorwerp 8,94,184
Voorwerp 9,98,192
Voorwerp 10,106,201
Voorwerp 11,110,210
Voorwerp 12,113,214
Voorwerp 13,115,221
Voorwerp 14,118,229
Voorwerp 15,120,240

Я пытаюсь решить проблему с рюкзаком с помощью GenSA и GA. Решение для этого набора данных должно быть около 1458.

Однако с этим кодом:

install.packages("GenSA")
install.packages("GA")
require(GenSA)
library(GenSA)
require(GA)
library(GA)

#Loading data
df <- read.csv("knapsack.csv", header=TRUE, sep=",")


#Define function
knapsack <- function(x) {
  f <- sum(x * df[3])
  penalty <- sum(df[2]) * abs(sum(x*df[2]) - 750)
  f - penalty
}

init <- runif(1, -5000, 5000)

onder <- rep(-5000, length(init))
boven <- rep(5000, length(init)) 



controlelijst <- list(max.time=25, nb.stop.improvement = 100)

resultaatSA <- GenSA(par=init, lower = onder, upper = boven, fn=knapsack, control=controlelijst)

resultaatSA$par




# Solution num 2
SGA <- ga(type="binary", fitness=knapsack, nBits=length(df[1]), maxiter=150, run=250, popSize=100, seed=101)

SGA
SGA@solution

я получаю много бессмысленной информации. GenSA, например, говорит, что решение составляет -5000, а иногда и 5000. Какие границы / ограничения я установил.

SA дает 1 в качестве решения.

Что именно я делаю не так и как нужно ли мне правильно использовать эти две функции?

Answer 1

В вызове GA вы передали неправильный nBits, как указано в комментарии user2957945

На основе: Решение проблемы с рюкзаком с помощью простого Geneti c Алгоритм У меня есть два решения с прибылью 1449 и весом 750

Edit : с большим количеством поколений и большей численностью населения я получил одно решение с прибылью 1456 и 750 вес

library(GA)
# --------------------------------------------------------------------
# Read Data
# --------------------------------------------------------------------
my_df <- read.table(text=',gewichten(gr),waarde
Voorwerp 1,70,135
Voorwerp 2,73,139
Voorwerp 3,77,149
Voorwerp 4,80,150
Voorwerp 5,82,156
Voorwerp 6,87,163
Voorwerp 7,90,173
Voorwerp 8,94,184
Voorwerp 9,98,192
Voorwerp 10,106,201
Voorwerp 11,110,210
Voorwerp 12,113,214
Voorwerp 13,115,221
Voorwerp 14,118,229
Voorwerp 15,120,240', sep=',', header=T)

# --------------------------------------------------------------------
# Define  profit, weights, Knapsack limit, and fitness function
# --------------------------------------------------------------------
p <- my_df$waarde
w <- my_df$gewichten.gr.
W <- 750
n <- length(p)

# Define fitness function 
knapsack <- function(x) { 
  f <- sum(x * p) 
  penalty <- sum(w) * abs(sum(x * w) - W) 
  f - penalty 
}

# --------------------------------------------------------------------
# Run SGA
# --------------------------------------------------------------------
SGA <- ga(type="binary", 
          fitness=knapsack , 
          nBits=n, 
          maxiter=500, # Maximum number of generations 
          run=200,     # Stop if the best-so-far fitness
          # hasn't improved for 'run' generations 
          popSize=200)


# --------------------------------------------------------------------
# see results
# --------------------------------------------------------------------
x.star <- SGA@solution 
# solutions
x.star
# number of elements in each solution
rowSums(x.star) 
# profit in each solution
rowSums(sweep(x.star, MARGIN=2, p, `*`))
# weight of each solution
rowSums(sweep(x.star, MARGIN=2, w, `*`))

Что касается функции GenSA, я не эксперт, но я думаю, что она предназначена для более сложных оптимизаций и минимизирует функцию (в отличие от ga, которая максимизирует функцию ), поэтому вы не можете использовать одну и ту же функцию для обоих методов. Еще одно предостережение заключается в том, что проблема с рюкзаком обычно считается двоичной проблемой (выберите 0, 1 для nBits), но я не уверен, что вы можете заставить GenSA сделать это, поэтому вам нужно найти обходной путь для это.

Вот моя попытка с GenSA, возвращает решение с прибылью 1456 и весом 750, я использовал round в качестве обходного пути для получения двоичного вывода

library(GenSA)

knapsack_gensa <- function(x) { 
  f <- sum(round(x) * p)
  penalty <- sum(w) * abs(sum(round(x) * w) - W) 
  penalty - f 
}
gensa <- GenSA(lower = rep(0, n), 
               upper = rep(1, n), 
               fn=knapsack_gensa)

solution <- round(gensa$par)
sum(solution)
sum(solution*p)
sum(solution*w)

Answer 2

Я думаю, что Джон Коулман прав, и вам нужно просто изменить знак своей функции стоимости, чтобы она была минимизирована. Ниже приведен (немного избыточный) пример того, как это небольшое добавление минуса к вашей функции приведет к совершенно другому решению (надеюсь, правильному). Я нанес на график результаты аналогично тому, как это делает GA, как я видел из вашего кода, что вы также рассматривали это как вариант (на самом деле довольно хороший). Для GA функция стоимости: максимальное , поэтому вам нужно удалить минус.

library(GenSA)
library(GA)

df <- read.table(text = ",gewichten(gr),waarde
Voorwerp 1,70,135
Voorwerp 2,73,139
Voorwerp 3,77,149
Voorwerp 4,80,150
Voorwerp 5,82,156
Voorwerp 6,87,163
Voorwerp 7,90,173
Voorwerp 8,94,184
Voorwerp 9,98,192
Voorwerp 10,106,201
Voorwerp 11,110,210
Voorwerp 12,113,214
Voorwerp 13,115,221
Voorwerp 14,118,229
Voorwerp 15,120,240", sep = ",", header = T
)


#Define function
knapsack <- function(x) {
  f <- sum(x * df[3])
  penalty <- sum(df[2]) * abs(sum(x*df[2]) - 750)
  -(f - penalty) # SIMPLY ADDED A MINUS SIGN
}

init <- runif(1, -5000, 5000)

onder <- rep(-5000, length(init))
boven <- rep(5000, length(init)) 


controlelijst <- list(max.time=25, nb.stop.improvement = 100)

resultaatSA <- GenSA(par=init, lower = onder, upper = boven, fn=knapsack, control=controlelijst)

resultaatSA$par # 0.5233775
head(resultaatSA$trace.mat)


# summarize results
tmp <- as.data.frame(resultaatSA$trace.mat)
meani <- aggregate(tmp$function.value, list(step = tmp$nb.steps),mean, na.rm = TRUE)
exe <- aggregate(tmp$current.minimum, list(step = tmp$nb.steps),mean, na.rm = TRUE)
medi <- aggregate(tmp$function.value, list(step = tmp$nb.steps),median, na.rm = TRUE)
ylim <- c(min(range(exe$x,na.rm = TRUE, finite = TRUE)),
          max(range(meani$x, na.rm = TRUE, finite = TRUE)))

# plot
op <- par(mar=c(5.1, 4.1, 1, 4.1))
plot(tmp$nb.steps, tmp$function.value, type = "n", ylim = ylim, xlab = "Iteration",
     ylab = "Cost value")
graphics::grid(equilogs = FALSE)
points(tmp$nb.steps, tmp$current.minimum, type = "o", pch = 16, lty = 1,
       col = "green3", cex = 0.7)
points(meani$step, meani$x, type = "o", pch = 1, lty = 2,
       col = "dodgerblue3", cex = 0.7)
polygon(c(meani$step, rev(meani$step)),
        c(exe$x, rev(medi$x)),
        border = FALSE, col = adjustcolor("green3", alpha.f = 0.1))
par(new=TRUE)
plot(tmp$nb.steps, tmp$temperature, t="l", col=2, lty=2, log="y", axes = FALSE, xlab = "", ylab = "")
axis(4, col=2, col.axis=2); mtext(text = "Temperature", side = 4, line = par()$mgp[1], col=2)
legend("topright", legend = c("Best", "Mean", "Median", "Temperature"),
       col = c("green3", "dodgerblue3", adjustcolor("green3", alpha.f = 0.1), 2),
       pch = c(16, 1, NA, NA), lty = c(1,2,1,2),
       lwd = c(1, 1, 10, 1), pt.cex = c(rep(0.7,2), 2, NA),
       inset = 0.02)
par(op)