时间戳

首页 > 解决方案 > 使用 R 解决 Lucky 26 游戏

r - 使用 R 解决 Lucky 26 游戏

问题描述

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

标签： rbigdatapermutation

解决方案

对于排列，很棒。不幸的是，12 个字段有 4.79亿种可能性，这意味着对大多数人来说占用了太多内存：

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

有一些替代方案。

  1. 对排列进行抽样。意思是，只做100万而不是4.79亿。为此，您可以使用permuteSample(12, 12, n = 1e6). 请参阅@JosephWood 的答案以获得某种类似的方法，除了他对 4.79 亿个排列进行采样；）

  2. 中构建一个循环来评估创建时的排列。这可以节省内存，因为您最终会构建函数以仅返回正确的结果。

  3. 用不同的算法解决问题。我将专注于这个选项。

带约束的新算法

幸运星 26 在 r

段数应为 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 的组合，我们需要确保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 的组合。例如，我们需要 take1, 2, 11, 12和 make 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()andReduce()来做更多的函数式编程——否则，很多代码会被输入六次。有关数学代码的更详尽解释，请参阅原始解决方案。

# 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 万个，并且只在 550 MB 的 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统计

推荐阅读