使用R来解决Lucky 26游戏

Question

我正试图向我的儿子展示如何使用编码来解决游戏所带来的问题，以及了解R如何处理大数据。有问题的游戏称为“幸运26”。在此游戏中，数字（1-12，无重复）位于大卫之星的12个点上（6个顶点，6个交点），并且6行4个数字必须全部加到26。在大约4.79亿可能性中（12P12 ）显然有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

Answer 1

这里是另一种方法。它基于第一个MATLAB的作者MathWorks blog post的Cleve Moler。

在博客文章中，为了节省内存，作者仅置换了10个元素，第一个元素作为顶点元素，第7个元素作为基本元素。因此，仅需要测试10! == 3628800排列。在下面的代码中，

1. 生成元素1到10的排列。共有10! == 3628800个。
2. 选择11作为顶点元素并保持固定。赋值从哪里开始并不重要，其他元素将位于正确的relative位置。
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

Answer 2

对于排列，rcppalgos非常好。不幸的是，有479个[[million可能性和12个字段，这意味着对于大多数人来说占用太多内存：

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

由reprex package（v0.3.0）在2019-12-07创建
有两种主要选择。 
抽样排列。意思是，只用permuteGeneral()做100万，而不是4.79亿。这也意味着您将无法获得全部144个解决方案，甚至可能无法获得1个解决方案。
在rcpp中建立循环以评估创建时的排列。这样可以节省内存，因为您最终会构建仅返回正确结果的函数。
这是第一个实际使用的示例：
library(RcppAlgos)
elements <- 12
set.seed(123)
y <- permuteSample(elements, elements, n = 1E6)

col_ind <- list(c(1, 3, 6, 8),
                c(1, 4, 7, 11),
                c(8, 9, 10, 11),
                c(2, 3, 4, 5),
                c(2, 6, 9, 12),
                c(5, 7, 10, 12))
# L replaces L1 <- y[,1] + y[,3] + y[,6] + y[,8]; L2 <- ...
# and rowSums(y[, c(1, 3, 6, 8)]) is the same as L1 <- y[, 1] +...
L <- lapply(col_ind, function(cols) rowSums(y[, cols]))
L_lgl <- lapply(L, `==`, 26)

# Reduce is the same as (L[[1]] & L[[2]]) & L[[3]] ...
soln <- Reduce(`&`, L_lgl)

#results in common - note for this seed we get one result but it will not always be the case
y[which(soln), ]
#>  [1]  4  5  3 12  6  9  2 10  1  7  8 11

# or for statistics
table(Reduce('+', L_lgl))
#> 
#>      0      1      2      3      4      6 
#> 655432 293565  46905   3845    252      1

由reprex package（v0.3.0）在2019-12-07创建

Answer 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