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

순열의 경우 rcppalgos 가 좋습니다. 불행히도 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. rcpp 에 루프 를 만들어 생성시 순열을 평가하십시오. 이렇게하면 올바른 결과 만 반환하는 함수를 작성하게되므로 메모리가 절약됩니다.

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

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

세그먼트는 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

공연

결국, 우리는 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

답변

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