लकी 26 गेम को हल करने के लिए आर का उपयोग करना


15

मैं अपने बेटे को यह दिखाने की कोशिश कर रहा हूं कि कैसे कोडिंग का उपयोग किसी गेम द्वारा उत्पन्न समस्या को हल करने के लिए किया जा सकता है और साथ ही यह देखने के लिए कि आर बड़े डेटा को कैसे संभालता है। प्रश्न में खेल को "लकी 26" कहा जाता है। इस गेम संख्या में (कोई डुप्लिकेट के साथ 1-12) डैविड (6 वर्टेक्स, 6 चौराहों) के एक स्टार पर 12 बिंदुओं पर तैनात हैं और 4 नंबर की 6 लाइनों को सभी को 269 में जोड़ना होगा। लगभग 479 मिलियन संभावनाएं (12P12) ) स्पष्ट रूप से 144 समाधान हैं। मैंने इसे आर के रूप में कोड करने की कोशिश की, लेकिन स्मृति एक ऐसा मुद्दा है जो ऐसा लगता है। अगर सदस्यों के पास समय हो तो मैं उत्तर देने के लिए किसी भी सलाह की बहुत सराहना करूंगा। सदस्यों का अग्रिम धन्यवाद।

library(gtools)

x=c()
elements <- 12
for (i in 1:elements)
{ 
    x[i]<-i
}

soln=c()            

y<-permutations(n=elements,r=elements,v=x)  
j<-nrow(y)
for (i in 1:j) 
{
L1 <- y[i,1] + y[i,3] + y[i,6] + y[i,8]
L2 <- y[i,1] + y[i,4] + y[i,7] + y[i,11]
L3 <- y[i,8] + y[i,9] + y[i,10] + y[i,11]
L4 <- y[i,2] + y[i,3] + y[i,4] + y[i,5]
L5 <- y[i,2] + y[i,6] + y[i,9] + y[i,12]
L6 <- y[i,5] + y[i,7] + y[i,10] + y[i,12]
soln[i] <- (L1 == 26)&(L2 == 26)&(L3 == 26)&(L4 == 26)&(L5 == 26)&(L6 == 26) 
}

z<-which(soln)
z

3
मुझे तर्क समझ में नहीं आता है लेकिन आपको अपने दृष्टिकोण को स्पष्ट करना चाहिए। x<- 1:elementsऔर अधिक महत्वपूर्ण बात L1 <- y[,1] + y[,3] + y[,6] + y[,8]। यह वास्तव में आपकी मेमोरी इश्यू में मदद नहीं करेगा ताकि आप हमेशा rcpp
Cole

4
कृपया rm(list=ls())अपने MRE में न डालें । यदि कोई सक्रिय सत्र में कॉपी-पेस्ट करता है तो वे अपना डेटा खो सकते हैं।
dww

Rm पर सूची (सूची = ls ()) ..
डेजर्टप्रूजेक्ट

क्या आप आश्वस्त हैं कि केवल 144 हैं? मैं अभी भी इस पर काम कर रहा हूं और मुझे 480 मिल रहे हैं लेकिन मैं अपने वर्तमान दृष्टिकोण के बारे में थोड़ा अनिश्चित हूं।
कोल

1
@, मुझे 960 समाधान मिल रहे हैं।
जोसेफ वुड

जवाबों:


3

यहाँ एक और दृष्टिकोण है। यह एक पर आधारित है MathWorks ब्लॉग पोस्ट द्वारा क्लीव मोलर , पहले MATLAB के लेखक।

ब्लॉग पोस्ट में, मेमोरी को बचाने के लिए लेखक केवल 10 तत्वों की अनुमति देता है, प्रथम तत्व को शीर्ष तत्व के रूप में और 7 वें को आधार तत्व के रूप में रखता है। इसलिए, केवल 10! == 3628800क्रमपरिवर्तन परीक्षण की आवश्यकता है।
नीचे दिए गए कोड में,

  1. 1करने के लिए तत्वों की क्रमपरिवर्तन उत्पन्न करें 1010! == 3628800इनकी कुल संख्या है।
  2. 11शीर्ष तत्व के रूप में चुनें और इसे ठीक रखें। यह वास्तव में मायने नहीं रखता है कि असाइनमेंट कहाँ से शुरू होते हैं, अन्य तत्व सही सापेक्ष स्थिति में होंगे।
  3. फिर एक forलूप में 12 वें तत्व को दूसरी स्थिति, 3 जी स्थिति आदि के लिए असाइन करें ।

यह अधिकांश समाधानों का उत्पादन, घुमाव या परावर्तन देता है या लेना चाहिए। लेकिन यह गारंटी नहीं देता कि समाधान अद्वितीय हैं। यह यथोचित उपवास भी है।

elements <- 12
x <- seq_len(elements)
p <- gtools::permutations(n = elements - 2, r = elements - 2, v = x[1:10])  

i1 <- c(1, 3, 6, 8)
i2 <- c(1, 4, 7, 11)
i3 <- c(8, 9, 10, 11)
i4 <- c(2, 3, 4, 5)
i5 <- c(2, 6, 9, 12)
i6 <- c(5, 7, 10, 12)

result <- vector("list", elements - 1)
for(i in 0:10){
  if(i < 1){
    p2 <- cbind(11, 12, p)
  }else if(i == 10){
    p2 <- cbind(11, p, 12)
  }else{
    p2 <- cbind(11, p[, 1:i], 12, p[, (i + 1):10])
  }
  L1 <- rowSums(p2[, i1]) == 26
  L2 <- rowSums(p2[, i2]) == 26
  L3 <- rowSums(p2[, i3]) == 26
  L4 <- rowSums(p2[, i4]) == 26
  L5 <- rowSums(p2[, i5]) == 26
  L6 <- rowSums(p2[, i6]) == 26

  i_sol <- which(L1 & L2 & L3 & L4 & L5 & L6)
  result[[i + 1]] <- if(length(i_sol) > 0) p2[i_sol, ] else NA
}
result <- do.call(rbind, result)
dim(result)
#[1] 82 12

head(result)
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
#[1,]   11   12    1    3   10    5    8    9    7     6     4     2
#[2,]   11   12    1    3   10    8    5    6    4     9     7     2
#[3,]   11   12    1    7    6    4    3   10    2     9     5     8
#[4,]   11   12    3    2    9    8    6    4    5    10     7     1
#[5,]   11   12    3    5    6    2    9   10    8     7     1     4
#[6,]   11   12    3    6    5    4    2    8    1    10     7     9

6

वास्तव में 960 समाधान हैं। नीचे हम 4 कोर का उपयोग करके समाधान प्राप्त करने के लिए Rcpp, RcppAlgos* , और parallelपैकेज का 6 secondsउपयोग करते हैं। यहां तक ​​कि अगर आप बेस आर के साथ एक भी थ्रेडेड दृष्टिकोण का उपयोग करना चुनते हैं lapply, तो समाधान लगभग 25 सेकंड में वापस आ जाता है।

सबसे पहले, हम एक सरल एल्गोरिथ्म लिखते हैं जिसमें C++एक विशेष क्रमपरिवर्तन की जाँच की जाती है। आप ध्यान देंगे कि हम सभी छह पंक्तियों को संग्रहीत करने के लिए एक सरणी का उपयोग करते हैं। यह प्रदर्शन के लिए है क्योंकि हम 6 व्यक्तिगत सरणियों का उपयोग करने से अधिक प्रभावी ढंग से कैश मेमोरी का उपयोग करते हैं। आपको यह भी ध्यान रखना होगा कि C++शून्य आधारित अनुक्रमण का उपयोग करता है।

#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::plugins(cpp11)]]

constexpr int index26[24] = {0, 2, 5, 7,
                             0, 3, 6, 10,
                             7, 8, 9, 10,
                             1, 2, 3, 4,
                             1, 5, 8, 11,
                             4, 6, 9, 11};

// [[Rcpp::export]]
IntegerVector DavidIndex(IntegerMatrix mat) {
    const int nRows = mat.nrow();
    std::vector<int> res;

    for (int i = 0; i < nRows; ++i) {
        int lucky = 0;

        for (int j = 0, s = 0, e = 4;
             j < 6 && j == lucky; ++j, s += 4, e += 4) {

            int sum = 0;

            for (int k = s; k < e; ++k)
                sum += mat(i, index26[k]);

            lucky += (sum == 26);
        }

        if (lucky == 6) res.push_back(i);
    }

    return wrap(res);
}

अब, में lowerऔर upperतर्कों का उपयोग करते हुए permuteGeneral, हम क्रमबद्धता को उत्पन्न कर सकते हैं और इनकी स्मृति को बनाए रखने के लिए व्यक्तिगत रूप से इनका परीक्षण कर सकते हैं। नीचे, मैंने एक बार में लगभग 4.7 मिलियन परमिट का परीक्षण करने के लिए चुना है। आउटपुट 12 के क्रमपरिवर्तन के शाब्दिक संकेत देता है! इस तरह कि लकी 26 की स्थिति संतुष्ट है।

library(RcppAlgos)
## N.B. 4790016L evenly divides 12!, so there is no need to check
## the upper bound on the last iteration below

system.time(solution <- do.call(c, parallel::mclapply(seq(1L, factorial(12), 4790016L), function(x) {
    perms <- permuteGeneral(12, 12, lower = x, upper = x + 4790015)
    ind <- DavidIndex(perms)
    ind + x
}, mc.cores = 4)))

  user  system elapsed 
13.005   6.258   6.644

## Foregoing the parallel package and simply using lapply,
## we obtain the solution in about 25 seconds:
##   user  system elapsed 
## 18.495   6.221  24.729

अब, हम उपयोग करते हुए सत्यापित करते हैं permuteSampleऔर तर्क sampleVecजो आपको विशिष्ट क्रमपरिवर्तन उत्पन्न करने की अनुमति देता है (जैसे यदि आप 1 पास करते हैं, तो यह आपको पहले क्रमपरिवर्तन (यानी 1:12) देगा।

system.time(Lucky26 <- permuteSample(12, 12, sampleVec=solution))
 user  system elapsed 
0.001   0.000   0.001

head(Lucky26)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,]    1    2    4   12    8   10    6   11    5     3     7     9
[2,]    1    2    6   10    8   12    4    7    3     5    11     9
[3,]    1    2    7   11    6    8    5   10    4     3     9    12
[4,]    1    2    7   12    5   10    4    8    3     6     9    11
[5,]    1    2    8    9    7   11    4    6    3     5    12    10
[6,]    1    2    8   10    6   12    4    5    3     7    11     9

tail(Lucky26)
       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[955,]   12   11    5    3    7    1    9    8   10     6     2     4
[956,]   12   11    5    4    6    2    9    7   10     8     1     3
[957,]   12   11    6    1    8    3    9    5   10     7     4     2
[958,]   12   11    6    2    7    5    8    3    9    10     4     1
[959,]   12   11    7    3    5    1    9    6   10     8     2     4
[960,]   12   11    9    1    5    3    7    2    8    10     6     4

अंत में, हम अपने समाधान को आधार R से सत्यापित करते हैं rowSums:

all(rowSums(Lucky26[, c(1, 3, 6, 8]) == 26)
[1] TRUE

all(rowSums(Lucky26[, c(1, 4, 7, 11)]) == 26)
[1] TRUE

all(rowSums(Lucky26[, c(8, 9, 10, 11)]) == 26)
[1] TRUE

all(rowSums(Lucky26[, c(2, 3, 4, 5)]) == 26)
[1] TRUE

all(rowSums(Lucky26[, c(2, 6, 9, 12)]) == 26)
[1] TRUE

all(rowSums(Lucky26[, c(5, 7, 10, 12)]) == 26)
[1] TRUE

* मैं लेखक हूंRcppAlgos


6

क्रमपरिवर्तन के लिए, बहुत अच्छा है। दुर्भाग्य से, 12 क्षेत्रों के साथ 479 मिलियन संभावनाएं हैं, जिसका मतलब है कि अधिकांश लोगों के लिए बहुत अधिक स्मृति है:

library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb

कुछ विकल्प हैं।

  1. क्रमपरिवर्तन का एक नमूना लें। मतलब, 479 मिलियन के बजाय केवल 1 मिलियन करें। ऐसा करने के लिए, आप उपयोग कर सकते हैं permuteSample(12, 12, n = 1e6)। देखें @ जोसेफवुड के जवाब के लिए कुछ हद तक समान दृष्टिकोण के अलावा वह 479 मिलियन पारगमन के लिए नमूने लेता है;)

  2. निर्माण पर क्रमचय का मूल्यांकन करने के लिए में एक लूप । यह मेमोरी बचाता है क्योंकि आप केवल सही परिणाम वापस करने के लिए फ़ंक्शन का निर्माण करेंगे।

  3. एक अलग एल्गोरिथ्म के साथ समस्या का दृष्टिकोण। मैं इस विकल्प पर ध्यान केंद्रित करूंगा।

नई एल्गोरिथ्म w / बाधाओं

लकी स्टार 26 में आर

खंड 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

भाग्यशाली स्टार समाधान आर आँकड़े


इस बारे में सोचने का अच्छा तरीका। धन्यवाद।
डेजर्टप्रोजेक्ट

1
मैं पहले से ही +1 करता हूं, काश मैं और दे पाता। यह वह विचार था जो मेरे पास मूल रूप से था लेकिन मेरा कोड बहुत गड़बड़ हो गया। सुंदर सामान!
जोसेफ वुड

1
इसके अलावा, पूर्णांक विभाजन (या हमारे मामले में रचनाएं) के अलावा, मैंने एक ग्राफ / नेटवर्क दृष्टिकोण का उपयोग करके मनोरंजन किया। यहां निश्चित रूप से एक ग्राफ घटक है, लेकिन फिर से, मैं इसके साथ कोई भी मुख्य रास्ता बनाने में सक्षम नहीं था। मुझे लगता है कि ग्राफ़ के साथ-साथ पूर्णांक रचनाओं का उपयोग करने से आपका दृष्टिकोण अगले स्तर पर आ सकता है।
जोसेफ वुड

3

यहां छवि विवरण दर्ज करें

यहाँ छोटी बेला के लिए समाधान है:

numbersToDrawnFrom = 1:12
bling=0

while(T==T){

  bling=bling+1
  x=sample(numbersToDrawnFrom,12,replace = F)

  A<-x[1]+x[2]+x[3]+x[4] == 26
  B<-x[4]+x[5]+x[6]+x[7] == 26
  C<-x[7] + x[8] + x[9] + x[1] == 26
  D<-x[10] + x[2] + x[9] + x[11] == 26
  E<-x[10] + x[3] + x[5] + x[12] == 26
  F1<-x[12] + x[6] + x[8] + x[11] == 26

  vectorTrue <- c(A,B,C,D,E,F1)

  if(min(vectorTrue)==1){break}
  if(bling == 1000000){break}

}

x
vectorTrue

"मैं अपने बेटे को यह दिखाने की कोशिश कर रहा हूं कि कैसे कोडिंग का इस्तेमाल किसी गेम के कारण होने वाली समस्या को हल करने के साथ-साथ यह देखने के लिए भी किया जा सकता है कि डेटा को कैसे हैंडल किया जाए।" -> हाँ। उम्मीद के मुताबिक कम से कम 1 समाधान है। लेकिन, डेटा को फिर से चलाने से अधिक समाधान मिल सकते हैं।
जॉर्ज लोपेज

इसे हल करने के लिए त्वरित समाधान - बहुत धन्यवाद!
डेजर्टप्रोजेक्ट
हमारी साइट का प्रयोग करके, आप स्वीकार करते हैं कि आपने हमारी Cookie Policy और निजता नीति को पढ़ और समझा लिया है।
Licensed under cc by-sa 3.0 with attribution required.