logo标签列表

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

rpermutation
62

我正在尝试创建一个列表的排列组合，例如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"))

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

3
在R语言中有几个用于生成排列的包。我写了一个**摘要**，其中包括每种可用方法的演示以及基准测试结果。 - Joseph Wood
13个回答
1
如有需要，可以使用“arrangements”包，只需执行以下操作即可：
> 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"
0

一个通用版本的rnso的答案是：

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)
}
-1

关于什么？

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[.])
}

这会返回一个列表。然后
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接