Найти все комбинации набора чисел, которые составляют в целом определенную сумму

Question

Я видел несколько решений похожих проблем, но все они требуют итерации по количеству элементов, которые должны быть добавлены вместе.

Вот моя цель: из списка чисел найти все комбинации (без замены), которые составляют определенную сумму. Например, если у меня есть числа 1,1,2,3,5 и общее число 5, оно должно вернуть 5, 2,3 и 1,1,3.

Я пытался использовать combn, но для этого требовалось указать количество предметов в каждой комбинации. Есть ли способ сделать это, что позволяет для наборов решений любого размера?

Answer 1

Не самый эффективный, но самый компактный на данный момент:

x <- c(1,1,2,3,5)
n <- length(x)
res <- 5
unique(combn(c(x,rep(0,n-1)), n, function(x) x[x!=0][sum(x)==res], FALSE))[-1]
# [[1]]
# [1] 1 1 3
# 
# [[2]]
# [1] 2 3
# 
# [[3]]
# [1] 5
# 

Answer 2

Это именно то, для чего были созданы combo/permuteGeneral из RcppAlgos (я автор). Поскольку у нас есть повторение определенных элементов в нашем образце вектора, мы будем находить комбинации мультимножеств , которые соответствуют нашим критериям. Обратите внимание, что это отличается от более распространенного случая генерации комбинаций с повторением, когда каждый элемент может повторяться m раз. Для многих функций генерации комбинаций мультимножества создают проблемы, так как вводятся дубликаты, и с ними нужно бороться. Это может стать узким местом в вашем коде, если размер ваших данных достаточно велик. Функции в RcppAlgos эффективно обрабатывают эти случаи, не создавая дублирующих результатов. Я должен упомянуть, что есть несколько других замечательных библиотек, которые хорошо справляются с мультимножествами: multicool и arrangements.

Переходя к поставленной задаче, мы можем использовать аргументы ограничения comboGeneral, чтобы найти все комбинации нашего вектора, которые соответствуют определенным критериям:

vec <- c(1,1,2,3,5)  ## using variables from @r2evans
uni <- unique(vec)
myRep <- rle(vec)$lengths
ans <- 5

library(RcppAlgos)
lapply(seq_along(uni), function(x) {
    comboGeneral(uni, x, freqs = myRep,
                 constraintFun = "sum",
                 comparisonFun = "==",
                 limitConstraints = ans)
})

[[1]]
[,1]
[1,]    5

[[2]]
[,1] [,2]
[1,]    2    3

[[3]]
[,1] [,2] [,3]
[1,]    1    1    3

[[4]]
[,1] [,2] [,3] [,4]  ## no solutions of length 4

Эти функции высоко оптимизированы и хорошо подходят для более крупных случаев. Например, рассмотрим следующий пример, который даст более 30 миллионов комбинаций:

set.seed(42)
bigVec <- sort(sample(1:30, 40, TRUE))

rle(bigVec)
Run Length Encoding
  lengths: int [1:22] 2 1 1 2 1 1 1 2 3 1 ...
  values : int [1:22] 1 3 4 5 7 8 9 12 14 15 ...

bigUni <- unique(bigVec)
bigRep <- rle(bigVec)$lengths
bigAns <- 199
len <- 12

comboCount(bigUni, len, freqs = bigRep)
[1] 30904021

Все результаты 300000+ возвращаются очень быстро:

system.time(bigTest <- comboGeneral(bigUni, len, freqs = bigRep,
                                    constraintFun = "sum",
                                    comparisonFun = "==",
                                    limitConstraints = bigAns))
 user  system elapsed 
0.383   0.008   0.390

head(bigTest)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,]    1    1    3    4    5    9   29   29   29    29    30    30
[2,]    1    1    3    4    5   12   26   29   29    29    30    30
[3,]    1    1    3    4    5   12   28   28   28    29    30    30
[4,]    1    1    3    4    5   12   28   28   29    29    29    30
[5,]    1    1    3    4    5   14   25   28   29    29    30    30
[6,]    1    1    3    4    5   14   25   29   29    29    29    30

nrow(bigTest)
[1] 370646

all(rowSums(bigTest) == bigAns)
[1] TRUE

Добавление

Я должен упомянуть, что, как правило, когда я вижу такую ​​проблему, как: "поиск всех комбинаций, которые суммируются с определенным числом" , моя первая мысль - целочисленные разбиения . Например, в связанной задаче Получение всех комбинаций с суммой до 100 в R , мы можем легко решить с помощью библиотеки partitions. Однако этот подход не распространяется на общий случай (как мы имеем здесь), где вектор содержит конкретное повторение, или у нас есть вектор, который содержит значения, которые нелегко преобразовать в целочисленный эквивалент (например, вектор (0.1, 0.2, 0.3, 0.4) может легко следует рассматривать как 1:4, однако обработка c(3.98486 7.84692 0.0038937 7.4879) как целых чисел и последующее применение подхода целочисленных разбиений потребует чрезмерной вычислительной мощности, делающей этот метод бесполезным).

Answer 3

Аналогично ответу Микки, мы можем использовать combn внутри другого механизма зацикливания. Я буду использовать lapply:

vec <- c(1,1,2,3,5)
ans <- 5

Filter(length, lapply(seq_len(length(vec)),
       function(i) {
         v <- combn(vec, i)
         v[, colSums(v) == ans, drop = FALSE]
       }))
# [[1]]
#      [,1]
# [1,]    5
# [[2]]
#      [,1]
# [1,]    2
# [2,]    3
# [[3]]
#      [,1]
# [1,]    1
# [2,]    1
# [3,]    3

Вы можете опустить часть Filter(length,, хотя она может вернуть количество пустых матриц. С ними достаточно легко иметь дело и игнорировать, я просто думал, что их удаление будет эстетически предпочтительным.

Этот метод дает вам матрицу с несколькими кандидатами в каждом столбце, поэтому

ans <- 4
Filter(length, lapply(seq_len(length(vec)),
       function(i) {
         v <- combn(vec, i)
         v[, colSums(v) == ans, drop = FALSE]
       }))
# [[1]]
#      [,1] [,2]
# [1,]    1    1
# [2,]    3    3
# [[2]]
#      [,1]
# [1,]    1
# [2,]    1
# [3,]    2

Если дубликаты являются проблемой, вы всегда можете сделать:

Filter(length, lapply(seq_len(length(vec)),
       function(i) {
         v <- combn(vec, i)
         v <- v[, colSums(v) == ans, drop = FALSE]
         v[,!duplicated(t(v)),drop = FALSE]
       }))
# [[1]]
#      [,1]
# [1,]    1
# [2,]    3
# [[2]]
#      [,1]
# [1,]    1
# [2,]    1
# [3,]    2

Answer 4

Теперь вот решение, включающее gtools:

# Creating lists of all permutations of the vector x
df1 <- gtools::permutations(n=length(x),r=length(x),v=1:length(x),repeats.allowed=FALSE)
ls1 <- list()
for(j in 1:nrow(df1)) ls1[[j]] <- x[df1[j,1:ncol(df1)]]  

# Taking all cumulative sums and filtering entries equaling our magic number
sumsCum <- t(vapply(1:length(ls1), function(j) cumsum(ls1[[j]]), numeric(length(x))))
indexMN <- which(sumsCum == magicNumber, arr.ind = T)
finalList <- list()
for(j in 1:nrow(indexMN)){
    magicRow <- indexMN[j,1]
    magicCol <- 1:indexMN[j,2]
    finalList[[j]] <- ls1[[magicRow]][magicCol]
}
finalList <- unique(finalList)

, где x = c(1,1,2,3,5) и magicNumber = 5.Это первый черновик, я уверен, что он может быть улучшен здесь и там.

Answer 5

Я взял вашу идею combn и перебрал возможные размеры наборов.

func = function(x, total){
    M = length(x)
    y = NULL
    total = 15
    for (m in 1:M){
        tmp = combn(x, m)
        ind = which(colSums(tmp) == total)
        if (length(ind) > 0){
            for (j in 1:length(ind))
                y = c(y, list(tmp[,ind[j]]))
            }
        }
    return (unique(lapply(y, sort)))
    }

x = c(1,1,2,3,5,8,13)

> func(x, 15)
[[1]]
[1]  2 13

[[2]]
[1]  1  1 13

[[3]]
[1] 2 5 8

[[4]]
[1] 1 1 5 8

[[5]]
[1] 1 1 2 3 8

Очевидно, что это будет иметь проблемы с ростом M, так как tmp станет довольно быстро большим, и длина y не может быть (возможно?) Предопределена.