从具有重复元素的向量生成所有唯一组合

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

使用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"

Answer 2

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 3

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"