CODEWITHSUNDEEP
rstringcombinations
ushham
ushham

Reputation: 305

List all combinations of strings that together cover all given elements

Say I am given the following strings:

1:{a,b,c,t}
2:{b,c,d}
3:{a,c,d}
4:{a,t}

I want to make a program that will give me all different combinations of these strings, where each combination has to include each given letter. So for example the above combinations are strings {1&2, 1&3, 2&3&4, 1&2&3&4, 2&4}.

I was thinking of doing this with for loops, where the program would look at the first string, find which elements are missing, then work down through the list to find strings which have these letters. However I think this idea will only find combinations of two strings, and also it requires listing all letters to the program which seems very un-economical.

Upvotes: 1

Views: 85

Answers (2)

Ernest A
Ernest A

Reputation: 7839

I think something like this should work.

sets <- list(c('a', 'b', 'c', 't'),
             c('b', 'c', 'd'),
             c('a', 'c', 'd'),
             c('a', 't'))

combinations <- lapply(2:length(sets),
                       function(x) combn(1:length(sets), x, simplify=FALSE))
combinations <- unlist(combinations, FALSE)
combinations
# [[1]]
# [1] 1 2
# 
# [[2]]
# [1] 1 3
# 
# [[3]]
# [1] 1 4
# 
# [[4]]
# [1] 2 3
# 
# [[5]]
# [1] 2 4
# 
# [[6]]
# [1] 3 4
# 
# [[7]]
# [1] 1 2 3
# 
# [[8]]
# [1] 1 2 4
# 
# [[9]]
# [1] 1 3 4
# 
# [[10]]
# [1] 2 3 4
# 
# [[11]]
# [1] 1 2 3 4

u <- unique(unlist(sets))
u
# [1] "a" "b" "c" "t" "d"

Filter(function(x) length(setdiff(u, unlist(sets[x]))) == 0, combinations)
# [[1]]
# [1] 1 2
# 
# [[2]]
# [1] 1 3
# 
# [[3]]
# [1] 2 4
# 
# [[4]]
# [1] 1 2 3
# 
# [[5]]
# [1] 1 2 4
# 
# [[6]]
# [1] 1 3 4
# 
# [[7]]
# [1] 2 3 4
# 
# [[8]]
# [1] 1 2 3 4

Upvotes: 1

Jean
Jean

Reputation: 1490

As a start... I'll edit this answer when I have time. The following result is dependent on the order of choice. I haven't figured out how to flatten the list yet. If I could flatten it, I would sort each result then remove duplicates.

v = list(c("a","b","c","t"),c("b","c","d"),c("a","c","d"),c("a","t"))

allChars <- Reduce(union, v) # [1] "a" "b" "c" "t" "d"

charInList <- function(ch, li) which(sapply(li, function(vect) ch %in% vect))
locations <- sapply(allChars, function(ch) charInList(ch, v) )
# > locations
# $a
# [1] 1 3 4
# 
# $b
# [1] 1 2
# 
# $c
# [1] 1 2 3
# 
# $t
# [1] 1 4
# 
# $d
# [1] 2 3

findStillNeeded<-function(chosen){
  haveChars <- Reduce(union, v[chosen]) 
  stillNeed <- allChars[!allChars %in% haveChars] 
  if(length(stillNeed) == 0 ) return(chosen) #terminate if you dont need any more characters
  return ( lapply(1:length(stillNeed), function(i) { #for each of the characters you still need
    loc <- locations[[stillNeed[i]]] #find where the character is located
    lapply(loc, function(j){
      findStillNeeded(c(chosen, j)) #when you add this location to the choices, terminate if you dont need any more characters
    }) 
  }) )

}

result<-lapply(1:length(v), function(i){
  findStillNeeded(i)
})

Upvotes: 0

Related Questions