Как выполнить повторную выборку в R, не повторяя перестановок?

Если в R установить set.seed (), а затем использовать функцию примера для рандомизации списка, могу ли я гарантировать, что не сгенерирую такую ​​же перестановку?

то есть ...

set.seed(25)
limit <- 3
myindex <- seq(0,limit)
for (x in seq(1,factorial(limit))) {
    permutations <- sample(myindex)
    print(permutations)
}

Это производит

[1] 1 2 0 3
[1] 0 2 1 3
[1] 0 3 2 1
[1] 3 1 2 0
[1] 2 3 0 1
[1] 0 1 3 2

будут ли все напечатанные перестановки уникальными? Или есть шанс, основываясь на том, как это реализовано, чтобы я мог получить несколько повторов?

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

(Я также хочу избежать использования функции вроде permn (), которая имеет очень механистический метод для генерации всех перестановок - она ​​не выглядит случайной.)

Кроме того, sidenote --- похоже, что эта проблема O ((n!)!), Если я не ошибаюсь.

Вопрос имеет много веских толкований. Комментарии - особенно те, которые указывают на необходимость перестановки 15 или более элементов (15! = 1307674368000 становится все больше) - предполагают, что нужна сравнительно небольшая случайная выборка без замены всех n! = n * (n-1) (n-2) ... * 2 * 1 перестановок 1: n. Если это правда, существуют (несколько) эффективные решения.

Следующая функция rpermпринимает два аргумента n(размер перестановок для выборки) и m(количество перестановок размера n для рисования). Если m достигает или превышает n !, функция займет много времени и вернет много значений NA: она предназначена для использования, когда n относительно велико (скажем, 8 или более) и m намного меньше, чем n !. Он работает, кэшируя строковое представление найденных к настоящему времени перестановок, а затем генерируя новые перестановки (случайным образом), пока не будет найдена новая. Он использует ассоциативную способность индексации списка R для быстрого поиска в списке ранее найденных перестановок.

rperm <- function(m, size=2) { # Obtain m unique permutations of 1:size

    # Function to obtain a new permutation.
    newperm <- function() {
        count <- 0                # Protects against infinite loops
        repeat {
            # Generate a permutation and check against previous ones.
            p <- sample(1:size)
            hash.p <- paste(p, collapse="")
            if (is.null(cache[[hash.p]])) break

            # Prepare to try again.
            count <- count+1
            if (count > 1000) {   # 1000 is arbitrary; adjust to taste
                p <- NA           # NA indicates a new permutation wasn't found
                hash.p <- ""
                break
            }
        }
        cache[[hash.p]] <<- TRUE  # Update the list of permutations found
        p                         # Return this (new) permutation
    }

    # Obtain m unique permutations.
    cache <- list()
    replicate(m, newperm())  
} # Returns a `size` by `m` matrix; each column is a permutation of 1:size.

Природа replicate состоит в том, чтобы возвращать перестановки как векторы столбцов ; например , следующее воспроизводит пример в исходном вопросе, транспонированный :

> set.seed(17)
> rperm(6, size=4)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    2    4    4    3    4
[2,]    3    4    1    3    1    2
[3,]    4    1    3    2    2    3
[4,]    2    3    2    1    4    1

Время отлично подходит для малых и средних значений m, примерно до 10000, но ухудшается для более серьезных проблем. Например, образец m = 10000 перестановок из n = 1000 элементов (матрица из 10 миллионов значений) был получен за 10 секунд; выборка из m = 20 000 перестановок из n = 20 элементов потребовала 11 секунд, хотя выходной результат (матрица из 400 000 записей) был намного меньше; и вычислительная выборка m = 100 000 перестановок из n = 20 элементов была прервана через 260 секунд (у меня не хватило терпения ждать завершения). Эта проблема масштабирования, по-видимому, связана с неэффективностью масштабирования в ассоциативной адресации R. Можно обойти это, создавая выборки в группах, скажем, 1000 или около того, затем объединяя эти выборки в большую выборку и удаляя дубликаты.

редактировать

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

Вот некоторые истекшие времена в секундах для диапазона размеров перестановок и количества запрошенных различных перестановок:

 Number Size=10 Size=15 Size=1000 size=10000 size=100000
     10    0.00    0.00      0.02       0.08        1.03
    100    0.01    0.01      0.07       0.64        8.36
   1000    0.08    0.09      0.68       6.38
  10000    0.83    0.87      7.04      65.74
 100000   11.77   10.51     69.33
1000000  195.5   125.5

(Очевидно, что аномальное ускорение от size = 10 до size = 15 связано с тем, что первый уровень кэша больше для size = 15, что уменьшает среднее количество записей в списках второго уровня, тем самым ускоряя ассоциативный поиск R. стоимость в оперативной памяти, выполнение может быть сделано быстрее за счет увеличения размера кэша верхнего уровня.Просто увеличение k.headна 1 (что увеличивает размер верхнего уровня на 10) ускорилось, например, rperm(100000, size=10)с 11,77 до 8,72 секунд. кэш увеличился в 10 раз, но не получил заметного прироста (8,51 секунды).

За исключением случая 1 000 000 уникальных перестановок из 10 элементов (значительная часть всех 10! = Около 3,63 млн. Таких перестановок), столкновения практически не обнаруживались. В этом исключительном случае было 169 310 столкновений, но не было полных отказов (фактически был получен миллион уникальных перестановок).

$n=5$$n=15$$n!$

Рабочий код следует.

rperm <- function(m, size=2) { # Obtain m unique permutations of 1:size
    max.failures <- 10

    # Function to index into the upper-level cache.
    prefix <- function(p, k) {    # p is a permutation, k is the prefix size
        sum((p[1:k] - 1) * (size ^ ((1:k)-1))) + 1
    } # Returns a value from 1 through size^k

    # Function to obtain a new permutation.
    newperm <- function() {
        # References cache, k.head, and failures in parent context.
        # Modifies cache and failures.        

        count <- 0                # Protects against infinite loops
        repeat {
            # Generate a permutation and check against previous ones.
            p <- sample(1:size)
            k <- prefix(p, k.head)
            ip <- cache[[k]]
            hash.p <- paste(tail(p,-k.head), collapse="")
            if (is.null(ip[[hash.p]])) break

            # Prepare to try again.
            n.failures <<- n.failures + 1
            count <- count+1
            if (count > max.failures) {  
                p <- NA           # NA indicates a new permutation wasn't found
                hash.p <- ""
                break
            }
        }
        if (count <= max.failures) {
            ip[[hash.p]] <- TRUE      # Update the list of permutations found
            cache[[k]] <<- ip
        }
        p                         # Return this (new) permutation
    }

    # Initialize the cache.
    k.head <- min(size-1, max(1, floor(log(m / log(m)) / log(size))))
    cache <- as.list(1:(size^k.head))
    for (i in 1:(size^k.head)) cache[[i]] <- list()

    # Count failures (for benchmarking and error checking).
    n.failures <- 0

    # Obtain (up to) m unique permutations.
    s <- replicate(m, newperm())
    s[is.na(s)] <- NULL
    list(failures=n.failures, sample=matrix(unlist(s), ncol=size))
} # Returns an m by size matrix; each row is a permutation of 1:size.

Использование uniqueв правильном направлении должно сделать трюк:

set.seed(2)
limit <- 3
myindex <- seq(0,limit)

endDim<-factorial(limit)
permutations<-sample(myindex)

while(is.null(dim(unique(permutations))) || dim(unique(permutations))[1]!=endDim) {
    permutations <- rbind(permutations,sample(myindex))
}
# Resulting permutations:
unique(permutations)

# Compare to
set.seed(2)
permutations<-sample(myindex)
for(i in 1:endDim)
{
permutations<-rbind(permutations,sample(myindex))
}
permutations
# which contains the same permutation twice

Я немного перейду к первому вопросу и предположу, что если вы имеете дело с относительно короткими векторами, вы можете просто сгенерировать все перестановки, используя permnих, и случайным образом упорядочить их с помощью sample:

x <- combinat:::permn(1:3)
> x[sample(factorial(3),factorial(3),replace = FALSE)]
[[1]]
[1] 1 2 3

[[2]]
[1] 3 2 1

[[3]]
[1] 3 1 2

[[4]]
[1] 2 1 3

[[5]]
[1] 2 3 1

[[6]]
[1] 1 3 2