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