Генерирование всех различных перестановок списка в R

Ответ 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"

Обратите внимание, что вычисление огромно, если элемент большой.

Ответ 2

A назад я должен был сделать это в базе 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" 

Ответ 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" 

Ответ 4

база 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}),]

Ответ 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" 

Ответ 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"

Надеюсь, это поможет.

Ответ 7

Try:

> 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, ]

Ответ 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

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

Ответ 9

Как насчет

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])