Optimizing the sum of a variable in R given a constraint

Question

Using the following dataset:

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)

I need a R function that will consider all combinations of rows where the sum of 'COST' is less than a fixed value - in this case, $500 - and make the optimal selection based on the summed 'POINTS'.

Your help is appreciated.

Imo, I don't know where to begin. Google searches have missed the mark. — B.Frost, Jun 21 '16 at 19:00
Thanks for showing a reproducible example. May be you can check `optim` or `library(IpSolve)` I am not really interested what you tried and stuff. It doesn't really help. — akrun, Jun 21 '16 at 19:03
This question will likely be closed as "too" broad. Do a search for the knapsack problem. This problem falls into that area. — lmo, Jun 21 '16 at 19:04
Bryan Goggin - the combination of rows with maximized sum of POINTS within the allowed summed COST — B.Frost, Jun 21 '16 at 21:10
Imo, thank you - 'knapsack' was the key search term. I believe I've found the solution with the adagio package. — B.Frost, Jun 21 '16 at 21:38

score 0 · Answer 1 · edited May 23 '17 at 12:09

So since this post is still open I thought I would give my solution. These kinds of problems are always fun. So, you can try to brute force the solution by checking all possible combinations (some 2^24, or over 16 million) one by one. This could be done by considering that for each combination, a value is either in it or not. Thinking in binary you could use the follow function code which was inspired by this post:

#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)

I estimate this would take many hours to run. Improvements could be made with parallelization, etc, but still this is a rather intense calculation. This method will also not scale very well, as an increase by 1 (to 25 different IDs now) will double the computation time. Another option would be to cheat a little. For example, we know that we have to stay under $500. If we added up the n cheapest items, at would n would we definitely be over $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

So any more than 5 IDs chosen and we are definitely over $500. What else.

Well we can run a little code and take the max for that portion and see what that tells us.

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

So we have to try to get over 549 points with the remaining 2^24 - 10000 choices. But:

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

Even if we sum the 4 highest point values, we still dont beat 549, so there is no reason to even search those. Further, the number of choices to consider must be greater than 4, but less than 6. My gut feeling tells me 5 would be a good number to try. Instead of looking at all 16 millions choices, we can just look at all of the ways to make 5 out of 24, which happens to be 24 choose 5:

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

We have a new max on the 2582nd iteration. To retrieve the IDs:

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

And to verify that nothing went wrong:

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

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

Optimizing the sum of a variable in R given a constraint

1 Answers1