How to call the output(s) of a combination that add up to a certain number?

Viewed 66

I am trying to see how many of the following returned combination add up to at least 46. What code should I input?

x=c(20,10,16,16,6,15)
L=combn(x,3)

L is a list of combination of 6 choose 3.

thank you!

4 Answers

Try this

x <- c(20,10,16,16,6,15)
sum(combn(x, 3, sum) >= 46)

Output

[1] 6

These types of problems are addressed by the package RcppAlgos*. The specific problem the OP has mentioned involves combinations of multisets, which with most standard tools, will produce many duplicate entries (which I'm assuming are not desired).

For example, the naive approach must first generate all combinations, sum the values, then check all them. Note that we are not taking advantage of the FUN = argument for demonstration purposes:

x <- c(20,10,16,16,6,15)

funNaive <- function(x, m, tar) {
    all_combs <- t(combn(x, m))
    ind <- which(rowSums(all_combs) >= tar)
    all_combs[ind, ]
}

funNaive(x, 3, 46)
     [,1] [,2] [,3]
[1,]   20   10   16
[2,]   20   10   16   <- duplicate of the 1st row
[3,]   20   16   16
[4,]   20   16   15
[5,]   20   16   15   <- duplicate of the 4th row
[6,]   16   16   15

You will note that the 1st and 2nd row are the same as well as the 3rd and 4th row. In total, there should only be 4 results for this problem.

Here is a better approach using comboGeneral from RcppAlgos. Note the use of the freqs parameter which is used to represents how many times each element of the source vector is repeated:

funAlgos <- function(x, m, tar) {
    x <- sort(x)
    myFreq <- rle(x)$lengths
    myVals <- rle(x)$values
    
    RcppAlgos::comboGeneral(myVals, m,
                            freqs = myFreq,
                            constraintFun = "sum",
                            comparisonFun = ">=",
                            limitConstraints = tar)
}

funAlgos(x, 3, 46)
     [,1] [,2] [,3]
[1,]   20   16   16
[2,]   20   16   15
[3,]   20   16   10
[4,]   16   16   15

You can alter the base approach above to give correct results. In this case we still cannot take advantage of the FUN = argument as we need to be able to remove duplicate combinations:

funNaiveCorrected <- function(x, m, tar) {
    x <- sort(x)
    all_combs <- t(combn(x, m))
    no_dupes <- all_combs[!duplicated(all_combs), ]
    ind <- which(rowSums(no_dupes) >= tar)
    no_dupes[ind, ]
}

funNaiveCorrected(x, 3, 46)
      [,1] [,2] [,3]
[1,]   20   10   16
[2,]   20   16   16
[3,]   20   16   15
[4,]   16   16   15

It must be stressed that we cannot simply apply unique to the source vector as we would miss combinations with repeated values.

For small problems, this is no concern, however for larger problems this will become a real bottleneck rapidly. Observe:

set.seed(42)
big_x <- sort(sample(25, replace = TRUE))
system.time(algos <- funAlgos(big_x, 10, 175))
user  system elapsed 
   0       0       0

dim(algos)
[1] 1668   10

system.time(naive <- funNaiveCorrected(big_x, 10, 175))
  user  system elapsed 
17.161   0.276  17.434

dim(naive)
[1] 1668   10

For even larger problems, the base approach will consume all of your available memory. Beware, trying the example below with the base approach is not recommended (N.B. choose(50, 20) ~= 4.712921e+13):

set.seed(1729)
huge_x <- sort(sample(50, replace = TRUE))
system.time(algos <- funAlgos(huge_x, 20, 800))
 user  system elapsed 
0.009   0.001   0.010

dim(algos)
[1] 13473    20

* I am the author of RcppAlgos

I think a good way to do this problem is to simply transpose the matrix of combinations you generate, find the sum, and filter those that add to 46.

transposeL<- as.data.frame(t(L)) %>% 
  mutate(sum=V1+V2+V3) %>%
  filter(sum>=46)

Building on Joe Erinjeri's answer, we can take any combination size and avoid having to write out the variable names (V1, V2, V3, ...) like so:

library(tidyverse)
c(20,10,16,16,6,15) %>% 
  combn(3) %>% 
  t() %>% 
  as.data.frame() %>% 
  mutate(V_sum = rowSums(.)) %>%  
  filter(V_sum >= 46) %>% 
  nrow()
  [1] 6
Related