Đối với hoán vị, RCppalgos là tuyệt vời. Thật không may, có 479 triệu khả năng với 12 trường có nghĩa là chiếm quá nhiều bộ nhớ cho hầu hết mọi người:
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
Có một số lựa chọn thay thế.
Lấy một mẫu của hoán vị. Ý nghĩa, chỉ làm 1 triệu thay vì 479 triệu. Để làm điều này, bạn có thể sử dụng permuteSample(12, 12, n = 1e6). Xem câu trả lời của @ JosephWood cho một cách tiếp cận tương tự ngoại trừ anh ta lấy mẫu tới 479 triệu hoán vị;)
Xây dựng một vòng lặp trong RCpp để đánh giá hoán vị khi tạo. Điều này giúp tiết kiệm bộ nhớ vì cuối cùng bạn sẽ xây dựng hàm để chỉ trả về kết quả chính xác.
Tiếp cận vấn đề với một thuật toán khác nhau. Tôi sẽ tập trung vào tùy chọn này.
Thuật toán mới w / ràng buộc
Phân khúc nên là 26
Chúng tôi biết rằng mỗi phân đoạn dòng trong ngôi sao ở trên cần thêm tối đa 26. Chúng tôi có thể thêm ràng buộc đó để tạo hoán vị - chỉ cung cấp cho chúng tôi các kết hợp có tối đa 26:
# only certain combinations will add to 26
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)
Các nhóm ABCD và EFGH
Trong ngôi sao trên, tôi đã tô màu ba nhóm khác nhau: ABCD , EFGH và IJLK . Hai nhóm đầu tiên cũng không có điểm chung và cũng nằm trên các phân đoạn quan tâm. Do đó, chúng ta có thể thêm một ràng buộc khác: đối với các kết hợp cộng tới 26, chúng ta cần đảm bảo ABCD và EFGH không có số trùng nhau. IJLK sẽ được chỉ định 4 số còn lại.
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)))
Cho phép qua các nhóm
Chúng ta cần tìm tất cả các hoán vị của mỗi nhóm. Đó là, chúng tôi chỉ có các kết hợp cộng tối đa 26. Ví dụ: chúng tôi cần thực hiện 1, 2, 11, 12và thực hiện 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]
Tính toán cuối cùng
Bước cuối cùng là làm toán. Tôi sử dụng lapply()và Reduce()ở đây để thực hiện lập trình chức năng nhiều hơn - nếu không, rất nhiều mã sẽ được gõ sáu lần. Xem giải pháp ban đầu để được giải thích kỹ hơn về mã toán học.
# 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
Hoán đổi ABCD và EFGH
Vào cuối đoạn mã trên, tôi đã lợi dụng rằng chúng ta có thể trao đổi ABCDvà EFGHđể có được các hoán vị còn lại. Đây là mã để xác nhận rằng có, chúng ta có thể trao đổi hai nhóm và chính xác:
# 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
Hiệu suất
Cuối cùng, chúng tôi chỉ đánh giá 1,3 triệu trong số 479 hoán vị và chỉ được xáo trộn qua 550 MB RAM. Phải mất khoảng 0,7 giây để chạy
# 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:elementsvà quan trọng hơnL1 <- y[,1] + y[,3] + y[,6] + y[,8]. Điều này thực sự không giúp ích gì cho vấn đề bộ nhớ của bạn, do đó bạn luôn có thể xem xét RCpp