生成R中列表的所有不同排列

Question

我正在尝试创建列表的排列列表，例如，perms(list("a", "b", "c"))返回

list(list("a", "b", "c"), list("a", "c", "b"), list("b", "a", "c"),
     list("b", "c", "a"), list("c", "a", "b"), list("c", "b", "a"))

我不确定如何继续，非常感谢任何帮助。

Answer 1

combinat::permn将完成这项工作：

> library(combinat)
> permn(letters[1:3])
[[1]]
[1] "a" "b" "c"

[[2]]
[1] "a" "c" "b"

[[3]]
[1] "c" "a" "b"

[[4]]
[1] "c" "b" "a"

[[5]]
[1] "b" "c" "a"

[[6]]
[1] "b" "a" "c"

请注意，如果元素很大，计算量很大。

Answer 2

前段时间我不得不在基地R中这样做而不加载任何包裹。

permutations <- function(n){
    if(n==1){
        return(matrix(1))
    } else {
        sp <- permutations(n-1)
        p <- nrow(sp)
        A <- matrix(nrow=n*p,ncol=n)
        for(i in 1:n){
            A[(i-1)*p+1:p,] <- cbind(i,sp+(sp>=i))
        }
        return(A)
    }
}

用法：

> matrix(letters[permutations(3)],ncol=3)
     [,1] [,2] [,3]
[1,] "a"  "b"  "c" 
[2,] "a"  "c"  "b" 
[3,] "b"  "a"  "c" 
[4,] "b"  "c"  "a" 
[5,] "c"  "a"  "b" 
[6,] "c"  "b"  "a" 

Answer 3

您可以尝试使用permutations()包中的gtools，但与permn()中的combinat不同，它不会输出列表：

> library(gtools)
> permutations(3, 3, letters[1:3])
     [,1] [,2] [,3]
[1,] "a"  "b"  "c" 
[2,] "a"  "c"  "b" 
[3,] "b"  "a"  "c" 
[4,] "b"  "c"  "a" 
[5,] "c"  "a"  "b" 
[6,] "c"  "b"  "a" 

Answer 4

base R也可以提供答案：

all <- expand.grid(p1 = letters[1:3], p2 = letters[1:3], p3 = letters[1:3], stringsAsFactors = FALSE) 
perms <- all[apply(all, 1, function(x) {length(unique(x)) == 3}),]

Answer 5

# Another recursive implementation    
# for those who like to roll their own, no package required 
    permutations <- function( x, prefix = c() )
    {
        if(length(x) == 0 ) return(prefix)
        do.call(rbind, sapply(1:length(x), FUN = function(idx) permutations( x[-idx], c( prefix, x[idx])), simplify = FALSE))
    }

    permutations(letters[1:3])
    #    [,1] [,2] [,3]
    #[1,] "a"  "b"  "c" 
    #[2,] "a"  "c"  "b" 
    #[3,] "b"  "a"  "c" 
    #[4,] "b"  "c"  "a" 
    #[5,] "c"  "a"  "b" 
    #[6,] "c"  "b"  "a" 

Answer 6

基本R中的解决方案，不依赖于其他包：

> getPerms <- function(x) {
    if (length(x) == 1) {
        return(x)
    }
    else {
        res <- matrix(nrow = 0, ncol = length(x))
        for (i in seq_along(x)) {
            res <- rbind(res, cbind(x[i], Recall(x[-i])))
        }
        return(res)
    }
}

> getPerms(letters[1:3])
     [,1] [,2] [,3]
[1,] "a"  "b"  "c" 
[2,] "a"  "c"  "b" 
[3,] "b"  "a"  "c" 
[4,] "b"  "c"  "a" 
[5,] "c"  "a"  "b" 
[6,] "c"  "b"  "a"

我希望这会有所帮助。

Answer 7

尝试：

> a = letters[1:3]
> eg = expand.grid(a,a,a)
> eg[!(eg$Var1==eg$Var2 | eg$Var2==eg$Var3 | eg$Var1==eg$Var3),]
   Var1 Var2 Var3
6     c    b    a
8     b    c    a
12    c    a    b
16    a    c    b
20    b    a    c
22    a    b    c

正如@Adrian在评论中所建议的那样，最后一行可以替换为：

eg[apply(eg, 1, anyDuplicated) == 0, ]

Answer 8

一个有趣的解决方案“概率”使用基础R的样本：

elements <- c("a", "b", "c")
k <- length(elements)
res=unique(t(sapply(1:200, function(x) sample(elements, k))))
# below, check you have all the permutations you need (if not, try again)
nrow(res) == factorial(k)
res

基本上你会调用许多随机样本，希望能够全部获得它们，并且你将它们与众不同。

Answer 9

如果有帮助，可以使用“安排”程序包，您只需执行以下操作即可：

> abc  = letters[1:3]

> permutations(abc)
     [,1] [,2] [,3]
[1,] "a"  "b"  "c" 
[2,] "a"  "c"  "b" 
[3,] "b"  "a"  "c" 
[4,] "b"  "c"  "a" 
[5,] "c"  "a"  "b" 
[6,] "c"  "b"  "a" 

Answer 10

我们可以对基本功能combn进行一些修改：

   combn_n <- function(x) {
      m <- length(x) - 1 # number of elements to choose: n-1 
      xr <- rev(x) # reversed x
      part_1 <- rbind(combn(x, m), xr, deparse.level = 0) 
      part_2 <- rbind(combn(xr, m), x, deparse.level = 0) 
      cbind(part_1, part_2)
       }

  combn_n(letters[1:3])

[,1] [,2] [,3] [,4] [,5] [,6]  
[1,] "a"  "a"  "b"  "c"  "c"  "b"   
[2,] "b"  "c"  "c"  "b"  "a"  "a"   
[3,] "c"  "b"  "a"  "a"  "b"  "c"   

Answer 11

rnso's answer的通用版本是：

get_perms <- function(x){
  stopifnot(is.atomic(x)) # for the matrix call to make sense
  out <- as.matrix(expand.grid(
    replicate(length(x), x, simplify = FALSE), stringsAsFactors = FALSE))
  out[apply(out,1, anyDuplicated) == 0, ]
}

这里有两个例子：

get_perms(letters[1:3])
#R>      Var1 Var2 Var3
#R> [1,] "c"  "b"  "a" 
#R> [2,] "b"  "c"  "a" 
#R> [3,] "c"  "a"  "b" 
#R> [4,] "a"  "c"  "b" 
#R> [5,] "b"  "a"  "c" 
#R> [6,] "a"  "b"  "c" 
get_perms(letters[1:4])
#R>       Var1 Var2 Var3 Var4
#R>  [1,] "d"  "c"  "b"  "a" 
#R>  [2,] "c"  "d"  "b"  "a" 
#R>  [3,] "d"  "b"  "c"  "a" 
#R>  [4,] "b"  "d"  "c"  "a" 
#R>  [5,] "c"  "b"  "d"  "a" 
#R>  [6,] "b"  "c"  "d"  "a" 
#R>  [7,] "d"  "c"  "a"  "b" 
#R>  [8,] "c"  "d"  "a"  "b" 
#R>  [9,] "d"  "a"  "c"  "b" 
#R> [10,] "a"  "d"  "c"  "b" 
#R> [11,] "c"  "a"  "d"  "b" 
#R> [12,] "a"  "c"  "d"  "b" 
#R> [13,] "d"  "b"  "a"  "c" 
#R> [14,] "b"  "d"  "a"  "c" 
#R> [15,] "d"  "a"  "b"  "c" 
#R> [16,] "a"  "d"  "b"  "c" 
#R> [17,] "b"  "a"  "d"  "c" 
#R> [18,] "a"  "b"  "d"  "c" 
#R> [19,] "c"  "b"  "a"  "d" 
#R> [20,] "b"  "c"  "a"  "d" 
#R> [21,] "c"  "a"  "b"  "d" 
#R> [22,] "a"  "c"  "b"  "d" 
#R> [23,] "b"  "a"  "c"  "d" 
#R> [24,] "a"  "b"  "c"  "d" 

也可以使用lapply来稍微改变Rick's answer，仅执行一次rbind，并减少[s]/[l]apply通话次数：

permutations <- function(x, prefix = c()){
  if(length(x) == 1) # was zero before
    return(list(c(prefix, x)))
  out <- do.call(c, lapply(1:length(x), function(idx) 
    permutations(x[-idx], c(prefix, x[idx]))))
  if(length(prefix) > 0L)
    return(out)
  
  do.call(rbind, out)
}

Answer 12

看哪，purrr ? 解决方案：

> map(1:3, ~ c('a', 'b', 'c')) %>%
    cross() %>%
    keep(~ length(unique(.x)) == 3) %>%
    map(unlist)
#> [[1]]
#> [1] "c" "b" "a"
#> 
#> [[2]]
#> [1] "b" "c" "a"
#> 
#> [[3]]
#> [1] "c" "a" "b"
#> 
#> [[4]]
#> [1] "a" "c" "b"
#> 
#> [[5]]
#> [1] "b" "a" "c"
#> 
#> [[6]]
#> [1] "a" "b" "c"

Answer 13

怎么样？

pmsa <- function(l) {
  pms <- function(n) if(n==1) return(list(1)) else unlist(lapply(pms(n-1),function(v) lapply(0:(n-1),function(k) append(v,n,k))),recursive = F)
  lapply(pms(length(l)),function(.) l[.])
}

这给出了一个列表。然后

pmsa(letters[1:3])