क्रमपरिवर्तन के लिए, rcppalgos बहुत अच्छा है। दुर्भाग्य से, 12 क्षेत्रों के साथ 479 मिलियन संभावनाएं हैं, जिसका मतलब है कि अधिकांश लोगों के लिए बहुत अधिक स्मृति है:
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
कुछ विकल्प हैं।
क्रमपरिवर्तन का एक नमूना लें। मतलब, 479 मिलियन के बजाय केवल 1 मिलियन करें। ऐसा करने के लिए, आप उपयोग कर सकते हैं permuteSample(12, 12, n = 1e6)
। देखें @ जोसेफवुड के जवाब के लिए कुछ हद तक समान दृष्टिकोण के अलावा वह 479 मिलियन पारगमन के लिए नमूने लेता है;)
निर्माण पर क्रमचय का मूल्यांकन करने के लिए आरसीपी में एक लूप बनाएं । यह मेमोरी बचाता है क्योंकि आप केवल सही परिणाम वापस करने के लिए फ़ंक्शन का निर्माण करेंगे।
एक अलग एल्गोरिथ्म के साथ समस्या का दृष्टिकोण। मैं इस विकल्प पर ध्यान केंद्रित करूंगा।
नई एल्गोरिथ्म w / बाधाओं
खंड 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 तक जोड़ते हैं, हमें यह सुनिश्चित करने की आवश्यकता है कि एबीसीडी और ईएफजीएच की संख्या ओवरलैप नहीं है। 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
गमागमन एबीसीडी और 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
प्रदर्शन
अंत में, हमने 479 क्रमोन्नति के केवल 1.3 मिलियन का मूल्यांकन किया और केवल 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