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


12

Если в 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!)!), Если я не ошибаюсь.


По умолчанию аргумент «replace» для «sample» установлен в FALSE.
Октябрь

Спасибо, Окрам, но это работает в рамках конкретного образца. Таким образом, это гарантирует, что 0,1,2 и 3 не повторится в рамках ничьей (поэтому я не могу нарисовать 0,1,2,2), но я не знаю, гарантирует ли это, что вторая выборка, Я не могу нарисовать ту же последовательность 0123 снова. Это то, что меня интересует в плане реализации, влияет ли установка семени на это повторение.
Mittenchops

Да, это то, что я наконец понял, прочитав ответы ;-)
ocram

1
Если limit превышает 12, вы, скорее всего, исчерпаете ОЗУ, когда R попытается выделить место для seq(1,factorial(limit)). (12! Требуется около 2 ГБ, поэтому 13! Потребуется около 25 ГБ, 14! Около 350 ГБ и т. Д.)
whuber

2
Существует быстрое, компактное и элегантное решение для генерации случайных последовательностей всех перестановок 1: n, при условии, что вы можете удобно хранить n! целые числа в диапазоне 0: (n!). Он объединяет представление таблицы перестановок перестановки с факториальной базой представлением чисел.
whuber

Ответы:


9

Вопрос имеет много веских толкований. Комментарии - особенно те, которые указывают на необходимость перестановки 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 или около того, затем объединяя эти выборки в большую выборку и удаляя дубликаты.

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

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

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

 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=5n=15n!

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

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.

Это близко, но я замечаю, что получаю некоторые ошибки, такие как 1, 2 и 4, но я думаю, что понимаю, что вы имеете в виду, и должен иметь возможность работать с этим. Благодаря! > rperm(6,3) $failures [1] 9 $sample [,1] [,2] [,3] [1,] 3 1 3 [2,] 2 2 1 [3,] 1 3 2 [4,] 1 2 2 [5,] 3 3 1 [6,] 2 1 3
Mittenchops

3

Использование 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

Извините за неправильное объяснение кода. Сейчас я немного спешу, но я с удовольствием отвечу на любые ваши вопросы позже. Кроме того, я понятия не имею о скорости вышеупомянутого кода ...
MånsT

1
Я функционализировал то, что вы мне дали таким образом: `myperm <- function (limit) {myindex <- seq (0, limit) endDim <-factorial (limit) permutations <-sample (myindex), тогда как (is.null (dim (unique) (перестановки))) || dim (уникальная (перестановки)) [1]! = endDim) {перестановки <- rbind (перестановки, образец (myindex))} return (уникальная (перестановки))} 'Работает, но пока я может сделать предел = 6, предел = 7 заставляет мой компьютер перегреваться. = PI думаю, что еще должен быть способ подвыборки этого ...
Mittenchops

@ Mittenchops, почему вы говорите, что нам нужно использовать уникальный для пересэмплирования в R без повторения перестановок? Спасибо.
Франк

2

Я немного перейду к первому вопросу и предположу, что если вы имеете дело с относительно короткими векторами, вы можете просто сгенерировать все перестановки, используя 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

Мне нравится это много, и я уверен, что это правильное мышление. Но моя проблема заключается в том, что я использую последовательность, доходящую до 10. Permn () был значительно медленнее между факториалом (7) и факториалом (8), поэтому я думаю, что 9 и 10 будут чрезмерно огромными.
Mittenchops

@Mittenchops Правда, но все же возможно, что вам действительно нужно рассчитать их только один раз, верно? Сохраните их в файл, а затем загрузите их, когда они вам понадобятся, и «пробы» из заранее определенного списка. Таким образом, вы можете сделать медленный расчет permn(10)или что-то еще только один раз.
Джоран

Правильно, но если я храню все перестановки где-то, даже это разбивается примерно на факториал (15) - просто слишком много места для хранения. Вот почему я задаюсь вопросом, позволит ли установка начальных чисел собрать образцы перестановок коллективно - и если нет, то есть ли алгоритм для этого.
Mittenchops

@Mittenchops Установка начального числа не повлияет на производительность, он просто гарантирует один и тот же запуск каждый раз, когда вы звоните в PRNG.
Роман Луштрик

1
@Mitten См. Справку для set.seed: она описывает, как сохранить состояние ГСЧ и восстановить его позже.
whuber
Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.