Генерация всех уникальных комбинаций из вектора с повторяющимися элементами

Question

Этот вопрос задавался ранее, но только для векторов с неповторяющимися элементами.Мне не удалось найти простое решение, чтобы получить все комбинации из вектора с повторяющимися элементами.Чтобы проиллюстрировать это, я привел пример ниже.

x <- c('red', 'blue', 'green', 'red', 'green', 'red')

Вектор x имеет 3 повторяющихся элемента для «красного» и 2 для «зеленого».Ожидаемый результат для всех уникальных комбинаций будет таким:

# unique combinations with one element
'red'
'blue'
'green'
# unique combination with two elements
'red', 'blue' # same as 'blue','red'
'red', 'green' 
'red', 'red'
'blue', 'green'
'green', 'green'
# unique combination with three elements
'red', 'blue', 'green'
'red', 'red', 'blue'
'red', 'red', 'green'
'red', 'red', 'red' # This is valid because there are three 'red's
'green', 'green', 'red'
'green', 'green', 'blue'
# more unique combinations with four, five, and six elements

Answer 1

library(DescTools)
x <- c('red', 'blue', 'green', 'red', 'green', 'red')

allSets <- lapply(1:length(x), function(i){
      unique(t(apply(CombSet(x,i,repl = F),1,sort)))
    })


#[1]]
#[,1]  [,2]   [,3]    [,4]  [,5]    [,6] 
#[1,] "red" "blue" "green" "red" "green" "red"

##[[2]]
#[,1]    [,2]   
#[1,] "blue"  "red"  
#[2,] "green" "red"  
#[3,] "red"   "red"  
#[4,] "blue"  "green"
#[5,] "green" "green"

#[[3]]
#[,1]    [,2]    [,3]   
#[1,] "blue"  "green" "red"  
#[2,] "blue"  "red"   "red"  
#[3,] "green" "red"   "red"  
#[4,] "green" "green" "red"  
#[5,] "red"   "red"   "red"  
#[6,] "blue"  "green" "green"

#[[4]]
#[,1]    [,2]    [,3]    [,4] 
#[1,] "blue"  "green" "red"   "red"
#[2,] "blue"  "green" "green" "red"
#[3,] "blue"  "red"   "red"   "red"
#[4,] "green" "green" "red"   "red"
#[5,] "green" "red"   "red"   "red"

#[[5]]
#[,1]    [,2]    [,3]    [,4]  [,5] 
#[1,] "blue"  "green" "green" "red" "red"
#[2,] "blue"  "green" "red"   "red" "red"
#[3,] "green" "green" "red"   "red" "red"

#[[6]]
#[,1]   [,2]    [,3]    [,4]  [,5]  [,6] 
#[1,] "blue" "green" "green" "red" "red" "red"

Answer 2

library(arrangements)

combinations(c("red", "blue", "green"), k = 2, freq = c(3, 1, 2))
#      [,1]    [,2]   
# [1,] "red"   "red"  
# [2,] "red"   "blue" 
# [3,] "red"   "green"
# [4,] "blue"  "green"
# [5,] "green" "green"

combinations(c("red", "blue", "green"), k = 3, freq = c(3, 1, 2))
#      [,1]   [,2]    [,3]   
# [1,] "red"  "red"   "red"  
# [2,] "red"  "red"   "blue" 
# [3,] "red"  "red"   "green"
# [4,] "red"  "blue"  "green"
# [5,] "red"  "green" "green"
# [6,] "blue" "green" "green"

Если вы не хотите вручную вводить частоты:

x <- c('red', 'blue', 'green', 'red', 'green', 'red')
tx <- table(x)
combinations(names(tx), k = 2, freq = tx)
#       [,1]    [,2]   
# [1,] "blue"  "green"
# [2,] "blue"  "red"  
# [3,] "green" "green"
# [4,] "green" "red"  
# [5,] "red"   "red" 

Или используя RcppAlgos:

library(RcppAlgos)
comboGeneral(names(tx), m=2, freqs = tx)
#       [,1]    [,2]   
# [1,] "blue"  "green"
# [2,] "blue"  "red"  
# [3,] "green" "green"
# [4,] "green" "red"  
# [5,] "red"   "red" 

Answer 3

Использование combn() с lapply() должно помочь.

x <- c('red', 'blue', 'green', 'red', 'green', 'red')

lapply(1:3, function(y) combn(x, y))

# [[1]]
     # [,1]  [,2]   [,3]    [,4]  [,5]    [,6] 
# [1,] "red" "blue" "green" "red" "green" "red"

# [[2]]
     # [,1]   [,2]    [,3]  [,4]    [,5]  [,6]    ...
# [1,] "red"  "red"   "red" "red"   "red" "blue"  ...
# [2,] "blue" "green" "red" "green" "red" "green" ...

# [[3]]
     # [,1]    [,2]   [,3]    [,4]   [,5]    [,6]    ...
# [1,] "red"   "red"  "red"   "red"  "red"   "red"   ...
# [2,] "blue"  "blue" "blue"  "blue" "green" "green" ...
# [3,] "green" "red"  "green" "red"  "red"   "green" ...

Все уникальные комбинации

lapply(cc, function(y)
  y[,!duplicated(apply(y, 2, paste, collapse="."))]
)

[[1]]
[1] "red"   "blue"  "green"

[[2]]
     [,1]   [,2]    [,3]  [,4]    [,5]   [,6]    [,7]   
[1,] "red"  "red"   "red" "blue"  "blue" "green" "green"
[2,] "blue" "green" "red" "green" "red"  "red"   "green"

[[3]]
     [,1]    [,2]   [,3]    [,4]    [,5]    [,6]  [,7]    ...
[1,] "red"   "red"  "red"   "red"   "red"   "red" "blue"  ...
[2,] "blue"  "blue" "green" "green" "red"   "red" "green" ...
[3,] "green" "red"  "red"   "green" "green" "red" "red"   ...

Хотя, строго говоря, это не все уникальные комбинации, как некоторыеиз них являются перестановками друг друга.

Собственно уникальные комбинации

lapply(cc, function(y)
  y[,!duplicated(apply(y, 2, function(z) paste(sort(z), collapse=".")))]
)

# [[1]]
# [1] "red"   "blue"  "green"

# [[2]]
     # [,1]   [,2]    [,3]  [,4]    [,5]   
# [1,] "red"  "red"   "red" "blue"  "green"
# [2,] "blue" "green" "red" "green" "green"

# [[3]]
     # [,1]    [,2]   [,3]    [,4]    [,5]  [,6]   
# [1,] "red"   "red"  "red"   "red"   "red" "blue" 
# [2,] "blue"  "blue" "green" "green" "red" "green"
# [3,] "green" "red"  "red"   "green" "red" "green"