R을 사용하여 Lucky 26 게임 해결


15

게임에서 발생하는 문제를 해결하고 R이 빅 데이터를 처리하는 방법을 확인하는 데 코딩을 사용하는 방법을 아들에게 보여 주려고합니다. 해당 게임을 "럭키 26"이라고합니다. 이 게임에서 (중복없이 1-12) 숫자는 다윗의 별 (6 개의 정점, 6 개의 교차점)에서 12 포인트에 위치하며 4 개의 숫자의 6 줄은 모두 26에 추가되어야합니다. ) 분명히 144 개의 솔루션이 있습니다. 다음과 같이 R로 이것을 코딩하려고 시도했지만 메모리가 문제입니다. 회원들이 시간을 가지고 있다면 답변을 발전시키기위한 조언을 크게 부탁드립니다. 사전에 감사합니다.

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 (list = ls ())에 사과 ..
DesertProject

144 개만 있다고 확신하십니까? 나는 아직도 그것에 대해 노력하고 있으며 480을 얻지 만 현재 접근 방식에 대해 확신이 없습니다.
Cole

1
@Cole, 960 개의 솔루션을 받고 있습니다.
Joseph Wood

답변:


3

다른 접근법이 있습니다. 첫 MATLAB의 저자 Cleve MolerMathWorks 블로그 게시물 을 기반으로합니다 .

블로그 게시물에서 메모리를 절약하기 위해 작성자는 첫 번째 요소를 정점 요소로, 일곱 번째 요소를 기본 요소로 유지하면서 10 개의 요소 만 순열합니다. 따라서 10! == 3628800순열 만 테스트하면됩니다.
아래 코드에서

  1. 요소의 순열 생성 1에를 10. 10! == 3628800그들 모두 가 있습니다.
  2. 11에이펙스 요소로 선택 하고 고정하십시오. 과제가 어디서 시작되는지는 중요하지 않으며 다른 요소는 올바른 상대 위치에 있습니다.
  3. 그런 다음 for루프 에서 두 번째 위치, 세 번째 위치 등에 12 번째 요소를 지정하십시오 .

이것은 대부분의 솔루션을 생성하고 회전 및 반사를 제공하거나 가져와야합니다. 그러나 솔루션이 고유하다는 보장은 없습니다. 또한 합리적으로 빠릅니다.

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 개의 솔루션이 있습니다. 아래에서 우리는 Rcpp, RcppAlgos*parallel패키지를 6 seconds사용하여 4 코어 이상을 사용하여 솔루션을 얻습니다 . base R과 함께 단일 스레드 방식을 사용하도록 선택하더라도 lapply솔루션은 약 25 초 내에 반환됩니다.

먼저 C++특정 순열을 검사하는 간단한 알고리즘을 작성합니다 . 6 개의 라인을 모두 저장하기 위해 하나의 배열을 사용합니다. 이는 6 개의 개별 어레이를 사용하는 것보다 캐시 메모리를보다 효과적으로 활용하기위한 성능입니다. C++0부터 시작하는 인덱싱 을 사용 한다는 점도 명심해야 합니다.

#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);
}

이제의 lowerand upper인수를 사용하여 permuteGeneral순열 청크를 생성하고 개별적으로 테스트하여 메모리를 점검 할 수 있습니다. 아래에서 한 번에 약 470 만 개의 순열을 테스트하기로 결정했습니다. 결과는 12의 순열의 사전 색인을 제공합니다! Lucky 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 개의 필드로 4 억 7,800 만 개의 가능성이 있습니다. 이는 대부분의 사람들에게 너무 많은 메모리를 차지한다는 것을 의미합니다.

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 백만 순열을 샘플링하는 것을 제외하고는 다소 유사한 접근법에 대해서는 @JosephWood의 답변을 참조하십시오.)

  2. 에 루프 를 만들어 생성시 순열을 평가하십시오. 이렇게하면 올바른 결과 만 반환하는 함수를 작성하게되므로 메모리가 절약됩니다.

  3. 다른 알고리즘으로 문제에 접근하십시오. 이 옵션에 중점을 둘 것입니다.

제약 조건이있는 새로운 알고리즘

행운의 별 26 in r

세그먼트는 26이어야합니다

위 별표의 각 선분은 최대 26 개가 필요하다는 것을 알고 있습니다. 순열을 생성하는 데 제약 조건을 추가 할 수 있습니다.

# only certain combinations will add to 26
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)

ABCDEFGH 그룹

위의 별에서 나는 ABCD , EFGHIJLK의 세 그룹을 다르게 색칠했습니다 . 처음 두 그룹은 공통점이 없으며 관심있는 라인 세그먼트에도 있습니다. 따라서 또 다른 제약 조건을 추가 할 수 있습니다. 최대 26 개의 조합의 경우 ABCDEFGH에 숫자가 겹치지 않도록해야합니다 . 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

공연

결국, 우리는 479 개의 순열 중 130 만 개만 평가했으며 550MB의 RAM을 통해서만 섞었습니다. 실행하는 데 약 0.7 초가 걸립니다.

# 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

운이 좋은 스타 솔루션 r 통계


이것에 대해 생각하는 좋은 방법. 감사합니다.
DesertProject

1
나는 이미 +1, 더 줄 수 있으면 좋겠다. 이것은 내가 원래 가진 아이디어 였지만 내 코드는 매우 지저분 해졌습니다. 아름다운 것들!
Joseph Wood

1
또한 정수 파티션 (또는 우리의 경우 구성) 외에도 그래프 / 네트워크 접근 방식을 사용하여 즐겁게했습니다. 여기에는 확실히 그래프 구성 요소가 있지만 다시 한 번 그래프를 만들 수 없었습니다. 어떻게 든 정수 구성을 그래프와 함께 사용하면 다음 단계로 접근 할 수 있다고 생각합니다.
Joseph Wood

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

"아들에게 게임에서 발생하는 문제를 해결하고 R이 빅 데이터를 처리하는 방법을 확인하는 데 코딩을 어떻게 사용할 수 있는지 보여 주려고 노력하고 있습니다." -> 예. 예상대로 하나 이상의 솔루션이 있습니다. 그러나 데이터를 다시 실행하면 더 많은 솔루션을 찾을 수 있습니다.
Jorge Lopez

이 문제를 해결하는 빠른 솔루션-많은 감사합니다!
DesertProject
당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.