Optimierung der Summe einer Variablen in R eine Einschränkung gegeben

Question

die folgenden Daten-Set verwenden:

ID=c(1:24) 
COST=c(85,109,90,104,107,87,99,95,82,112,105,89,101,93,111,83,113,81,97,97,91,103,86,108) 
POINTS=c(113,96,111,85,94,105,105,95,107,88,113,100,96,89,89,93,100,92,109,90,101,114,112,109) 
mydata=data.frame(ID,COST,POINTS) 

ich eine R-Funktion benötigen, die alle Kombinationen von Zeilen betrachten, wo die Summe von ‚Kosten‘ ist weniger als ein fester Wert - in diesem Fall $ 500 - und die optimale Auswahl basierend auf den summierten 'POINTS'.

Ihre Hilfe wird geschätzt.

Answer 1

Also da dieser Beitrag noch offen ist dachte ich, ich würde meine Lösung geben. Diese Art von Problemen macht immer Spaß. Sie können also versuchen, die Lösung zu erzwingen, indem Sie nacheinander alle möglichen Kombinationen (etwa 2^24 oder über 16 Millionen) prüfen. Dies könnte dadurch geschehen, dass berücksichtigt wird, dass für jede Kombination ein Wert entweder vorhanden ist oder nicht. in binären Denken könnte man den Folgefunktionscode verwenden, die durch this Post inspiriert wurde:

#DO NOT RUN THIS CODE 
for(i in 1:2^24) 
    sum_points[i]<-ifelse(sum(as.numeric((intToBits(i)))[1:24] * mydata$COST) < 500, 
         sum(as.numeric((intToBits(i)))[1:24] * mydata$POINTS), 
         0) 

Ich schätze, das viele Stunden dauern würde zu laufen. Verbesserungen könnten mit Parallelisierung usw. gemacht werden, aber dies ist immer noch eine ziemlich intensive Berechnung. Diese Methode wird auch nicht sehr gut skalieren, da eine Erhöhung um 1 (auf jetzt 25 verschiedene IDs) die Rechenzeit verdoppelt. Eine andere Möglichkeit wäre ein wenig zu betrügen. Zum Beispiel wissen wir, dass wir unter $ 500 bleiben müssen. Wenn wir die n billigsten Artikel zusammenzählen würden, wären wir definitiv über $ 500?

which(cumsum(sort(mydata$COST))>500) 
[1] 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 

Also mehr als 5 IDs gewählt und wir sind definitiv über $ 500. Was sonst.

Nun, wir können ein wenig Code ausführen und die Max für diesen Teil nehmen und sehen, was uns das sagt.

sum_points<-1:10000 

for(i in 1:10000) 
    sum_points[i]<-ifelse(sum(as.numeric((intToBits(i)))[1:24]) <6, 
          ifelse(sum(as.numeric((intToBits(i)))[1:24] * mydata$COST) < 500, 
            sum(as.numeric((intToBits(i)))[1:24] * mydata$POINTS), 
            0), 
           0) 
sum_points[which.max(sum_points)] 
[1] 549 

Also müssen wir versuchen, über 549 Punkte mit den restlichen 2^24 zu bekommen - 10000 Entscheidungen. Aber:

which(cumsum(rev(sort(mydata$POINTS)))<549) 
[1] 1 2 3 4 

Auch wenn wir die vier höchsten Punktwerte summieren, wir nicht noch 549 schlagen, so gibt es keinen Grund, auch diejenigen zu suchen. Außerdem muss die Anzahl der zu berücksichtigenden Optionen größer als 4, aber kleiner als 6 sein. Mein Bauchgefühl sagt mir, dass 5 eine gute Zahl wäre, um es zu versuchen. Statt bei allen Entscheidungen 16 Millionen suchen, können wir auf all den Möglichkeiten suchen, nur 5 von 24 zu machen, die 24 wählen 5 passiert zu sein:

num<-1:choose(24,5) 
combs<-combn(24,5) 

sum_points<-1:length(num) 

    for(i in num) 
    sum_points[i]<-ifelse(sum(mydata[combs[,i],]$COST) < 500, 
         sum(mydata[combs[,i],]$POINTS), 
           0) 
which.max(sum_points) 
[1] 2582 

sum_points[2582] 
[1] 563 

Wir haben einen neuen max auf der 2582. Iteration. Um die IDs abrufen:

mydata[combs[,2582],]$ID 
[1] 1 3 11 22 23 

Und um sicherzustellen, dass nichts schief gelaufen ist:

sum(mydata[combs[,2582],]$COST) 
[1] 469 #less than 500 

sum(mydata[combs[,2582],]$POINTS) 
[1] 563 #what we expected.