Einschränkungen einer Multi-Zielfunktion in nsga2 setzen R

Question

Ich möchte die Funktion nsga2 in Bibliothek mco verwenden, um ein Mehrzielproblem zu lösen und das Pareto Frontier zu finden, aber ich konnte die Einschränkungen nicht richtig einrichten.

Die Zielfunktionen sind unten aufgeführt. Der Kontext des Problems ist die Projektauswahl, d. H. Ich habe fünf Projekte, die durch x [1], x [2], ... x [5] repräsentiert werden, und nur einige können ausgewählt werden. Wenn beispielsweise das Projekt Nr. 1 ausgewählt ist, wird x [1] = 1, wenn nicht ausgewählt, x [1] = 0, und dies gilt für alle Projekte (Wert von x [n] ist diskret, entweder 1 oder 0). Eine weitere Einschränkung, die ich habe, ist das Gesamtbudget der ausgewählten Projekte sollte weniger als 100 sein. Nach dem Ausführen der nsga2 Funktion scheinen die Parameter in der Solution nicht richtig zu sein, da die Parameter nicht 1 oder 0 sind. Habe ich die Einschränkungen falsch? Wie kann ich optimale Werte von x [1] bis x [5] finden? Vielen Dank!

# objective functions to minimize 
ObjFun <- function (x){ 
    f1 <- -0.02*x[1] + 0.01*x[2] + 0.02*x[3] + -0.01*x[4] + 0.02*x[5] 
    f2 <- 0.17*x[1] + -0.08*x[2] + 0.10*x[3] + 0.09*x[4] + 0.07*x[5] 
    c(f1, f2)  } 

# The constraints 
Constr <- function(x){ 
    100 >= 20*x[1] + 30*x[2] + 20*x[3] + 33*x[4] + 60*x[5] # Total budget >= total project costs 
    x[1:5] == 1 
    x[1:5] == 0  } 

library(mco) 
Solution <- nsga2(ObjFun, 5, 2, lower.bounds=c(0,0,0,0,0), upper.bounds=c(1,1,1,1,1), constraints = Constr) 
# plot(Solution) 
Solution$par 

Answer 1

Seit x[i] nur 1 oder 0 sein kann, Sie mit einem kombinatorischen Optimierungsproblem zu tun hat, wo der Raum, den Sie auf optimieren müssen, ist diskret:

https://en.wikipedia.org/wiki/Combinatorial_optimization

Im Allgemeinen numerische Optimierung Routinen sind so konstruiert, dass sie an kontinuierlichen Räumen arbeiten (Teilmengen von R^n). In Ihrem Fall ist der diskrete Raum jedoch klein und das Problem eignet sich für einen einfachen Brute-Force-Ansatz, bei dem Sie ObjFunc an allen 32 möglichen Punkten bewerten. Die Pareto-Grenze ist hier auch diskret.

## objective functions to minimize 
ObjFun <- function (x){ 
    f1 <- -0.02*x[1] + 0.01*x[2] + 0.02*x[3] + -0.01*x[4] + 0.02*x[5] 
    f2 <- 0.17*x[1] + -0.08*x[2] + 0.10*x[3] + 0.09*x[4] + 0.07*x[5] 
    c(f1=f1, f2=f2) 
} 

## space of all 32 feasible solutions 
space <- expand.grid(data.frame(matrix(0:1, nrow=2, ncol=5))) 
## brute force evaluation of ObjFun on all the 32 feasible solutions 
val <- sapply(data.frame(t(space)), ObjFun) 
tmp <- sol <- cbind(space, t(val)) 

## returns indices of all rows which are Pareto dominated 
## by the i-th row 
which.are.dominated <- function(i, tmp){ 
    s1 <- tmp$f1[i] 
    s2 <- tmp$f2[i] 
    with(tmp, 
     which((s1 <= f1) & 
       (s2 <= f2) & 
       ((s1 < f1) | 
        (s2 < f2)) 
       )) 
} 
## For each feasible solution i, remove all feasible solutions which are Pareto dominated by feasible solutions i 
i <- 1 
repeat{ 
    remove <- which.are.dominated(i, tmp) 
    if(length(remove)>0) tmp <- tmp[-remove, ] 
    if(i>=nrow(tmp)) break 
    i <- i+1 
} 
with(sol, plot(f1, f2)) 
points(tmp$f1, tmp$f2, pch=20, col=2) 
legend("topright", col=2, pch=20, "Pareto frontier") 

Referenzen:

https://en.wikipedia.org/wiki/Multi-objective_optimization

https://en.wikipedia.org/wiki/Pareto_efficiency

P. S. Ich habe für möglicherweise erstmals eine repeat Anweisung zu verwenden, seitdem ich begann ...

Bearbeiten vor Jahren R zu verwenden: Ein nicht Brute-Force-Ansatz ist nsga2 zu verwenden: D Wie ich es eingestellt Nach oben werden Lösungen nach x gesucht, die im n-dimensionalen Würfel [0,1]^n variieren, wobei n die Anzahl der Projekte ist; der Algorithmus erzeugt eine Anzahl von Lösungen (200 in meinem Beispiel), die Sie dann mit round auf 0 oder 1 "diskretisieren" können. Bei einer größeren Anzahl von Projekten müssen Sie, um eine genauere Annäherung an die Pareto-Grenze zu erhalten, mehr Generationen verwenden (z. B. 600). In den endgültigen Plots wird nur eine Stichprobe der Kosten dargestellt, wenn mehr als 12 Projekte berücksichtigt werden.

##n.projects <- 12 
n.projects <- 50 
if(n.projects>25) generations=600 


set.seed(1) 
vecf1 <- rnorm(n.projects) 
vecf2 <- rnorm(n.projects) 
vcost <- rnorm(n.projects) 
n.solutions <- 200 

library(mco) 

ObjFun <- function (x){ 
    f1 <- sum(vecf1*x) 
    f2 <- sum(vecf2*x) 
    c(f1=f1, f2=f2) 
} 
Constr <- function(x){ 
    c(100 - sum(vcost*x)) # Total budget >= total project costs 
} 

Solution <- nsga2(ObjFun, n.projects, 2, 
        lower.bounds=rep(0,n.projects), upper.bounds=rep(1,n.projects), 
        popsize=n.solutions, constraints = Constr, cdim=1, 
        generations=generations) 

selected.project.combinations <- unique(round(Solution$par)) 
selected.project.combinations.costs <- sapply(data.frame(t(selected.project.combinations)), ObjFun) 

## final plotting of results 
max.n.proj.plot <- 12 
if(n.projects <= max.n.proj.plot){ 
    xsamp <- expand.grid(data.frame(matrix(0:1, nrow=2, ncol=n.projects))) 
}else{ 
    xsamp <- matrix(sample(0:1, n.projects*2^max.n.proj.plot, replace=TRUE), ncol=n.projects) 
} 
fsamp <- sapply(data.frame(t(xsamp)), ObjFun) 

par(mfrow=c(1,2)) 
plot(Solution) 
points(fsamp[1, ], fsamp[2, ]) 
points(t(selected.project.combinations.costs), col=3, pch=20) 
legend("bottomleft", bty="n", pch=c(20,1), col=c(3,1), 
     c("Costs of optimal\nproject combinations", 
     "Costs of discarded\nproject combinations"), 
     y.intersp=1.8 
     ) 

plot(t(fsamp), xlim=range(Solution$value[ ,1], fsamp[1, ]), 
    ylim=range(Solution$value[ ,2], fsamp[2, ])) 
points(Solution$value, col=2, pch=".") 
points(t(selected.project.combinations.costs), col=3, pch=20)