Для перестановок відмінно підходить rcppalgos . На жаль, є 479 мільйонів можливостей з 12 полів, а це означає, що більшість людей займає занадто багато пам’яті:
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
Є кілька альтернатив.
Візьміть зразок перестановок. Значить, лише 1 мільйон замість 479 мільйонів. Для цього можна скористатися permuteSample(12, 12, n = 1e6). Дивіться відповідь @ Джозефа Вуда про дещо подібний підхід, за винятком того, що він вибирає 479 мільйонів перестановок;)
Побудуйте цикл у rcpp для оцінки перестановки на створенні. Це економить пам’ять, оскільки ви в кінцевому підсумку побудуєте функцію для повернення лише правильних результатів.
Підійдіть до проблеми за допомогою іншого алгоритму. Я зупинюсь на цьому варіанті.
Новий алгоритм з обмеженнями
Сегментів має бути 26
Ми знаємо, що кожен сегмент рядка в зірці вище повинен складати до 26. Ми можемо додати це обмеження для створення наших перестановок - дайте нам лише комбінації, які складають до 26:
# only certain combinations will add to 26
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)
Групи ABCD та EFGH
На зірці вище я пофарбував три групи по-різному: ABCD , EFGH та IJLK . Перші дві групи також не мають спільних моментів, а також знаходяться на цікавих сегментах. Тому ми можемо додати ще одне обмеження: для комбінацій, які складають до 26, нам потрібно переконатися, що ABCD та EFGH не мають перекриття чисел. IJLK буде присвоєно решта 4 числа.
library(RcppAlgos)
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)
two_combo <- comboGeneral(nrow(lucky_combo), 2)
unique_combos <- !apply(cbind(lucky_combo[two_combo[, 1], ], lucky_combo[two_combo[, 2], ]), 1, anyDuplicated)
grp1 <- lucky_combo[two_combo[unique_combos, 1],]
grp2 <- lucky_combo[two_combo[unique_combos, 2],]
grp3 <- t(apply(cbind(grp1, grp2), 1, function(x) setdiff(1:12, x)))
Перестановка через групи
Нам потрібно знайти всі перестановки кожної групи. Тобто у нас є лише комбінації, які складають до 26. Наприклад, нам потрібно брати 1, 2, 11, 12і робити 1, 2, 12, 11; 1, 12, 2, 11; ....
#create group perms (i.e., we need all permutations of grp1, grp2, and grp3)
n <- 4
grp_perms <- permuteGeneral(n, n)
n_perm <- nrow(grp_perms)
# We create all of the permutations of grp1. Then we have to repeat grp1 permutations
# for all grp2 permutations and then we need to repeat one more time for grp3 permutations.
stars <- cbind(do.call(rbind, lapply(asplit(grp1, 1), function(x) matrix(x[grp_perms], ncol = n)))[rep(seq_len(sum(unique_combos) * n_perm), each = n_perm^2), ],
do.call(rbind, lapply(asplit(grp2, 1), function(x) matrix(x[grp_perms], ncol = n)[rep(1:n_perm, n_perm), ]))[rep(seq_len(sum(unique_combos) * n_perm^2), each = n_perm), ],
do.call(rbind, lapply(asplit(grp3, 1), function(x) matrix(x[grp_perms], ncol = n)[rep(1:n_perm, n_perm^2), ])))
colnames(stars) <- LETTERS[1:12]
Підсумкові розрахунки
Останній крок - зробити математику. Я використовую lapply()і Reduce()тут, щоб робити більш функціональне програмування - інакше багато коду було б набрано шість разів. Дивіться оригінальне рішення для більш ретельного пояснення математичного коду.
# creating a list will simplify our math as we can use Reduce()
col_ind <- list(c('A', 'B', 'C', 'D'), #these two will always be 26
c('E', 'F', 'G', 'H'), #these two will always be 26
c('I', 'C', 'J', 'H'),
c('D', 'J', 'G', 'K'),
c('K', 'F', 'L', 'A'),
c('E', 'L', 'B', 'I'))
# Determine which permutations result in a lucky star
L <- lapply(col_ind, function(cols) rowSums(stars[, cols]) == 26)
soln <- Reduce(`&`, L)
# A couple of ways to analyze the result
rbind(stars[which(soln),], stars[which(soln), c(1,8, 9, 10, 11, 6, 7, 2, 3, 4, 5, 12)])
table(Reduce('+', L)) * 2
2 3 4 6
2090304 493824 69120 960
Обмін ABCD та EFGH
Наприкінці коду вище, я скористався тим, що ми можемо поміняти місцями ABCDта EFGHотримати інші перестановки. Ось код, щоб підтвердити, що так, ми можемо поміняти дві групи та бути правильними:
# swap grp1 and grp2
stars2 <- stars[, c('E', 'F', 'G', 'H', 'A', 'B', 'C', 'D', 'I', 'J', 'K', 'L')]
# do the calculations again
L2 <- lapply(col_ind, function(cols) rowSums(stars2[, cols]) == 26)
soln2 <- Reduce(`&`, L2)
identical(soln, soln2)
#[1] TRUE
#show that col_ind[1:2] always equal 26:
sapply(L, all)
[1] TRUE TRUE FALSE FALSE FALSE FALSE
Продуктивність
Врешті-решт, ми оцінили лише 1,3 мільйона з 479 перестановок і лише перемістилися через 550 МБ оперативної пам’яті. Для запуску потрібно близько 0,7s
# A tibble: 1 x 13
expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc
<bch:expr> <bch> <bch:> <dbl> <bch:byt> <dbl> <int> <dbl>
1 new_algo 688ms 688ms 1.45 550MB 7.27 1 5
x<- 1:elementsі ще важливішеL1 <- y[,1] + y[,3] + y[,6] + y[,8]. Це насправді не допоможе проблемі з вашою пам’яттю, тому ви завжди можете заглянути в rcpp