使用 R 解决 Lucky 26 游戏
Des*_*ect 15 r permutation bigdata
我试图向我的儿子展示如何使用编码来解决游戏带来的问题，以及了解 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
对于排列，rcppalgos很棒。不幸的是，12 个字段有 4.79亿种可能性，这意味着对大多数人来说占用太多内存：
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
有一些替代方案。
取一个排列的样本。意思是，只做 100 万而不是 4.79 亿。为此，您可以使用
permuteSample(12, 12, n = 1e6). 请参阅@JosephWood 的答案以了解某种类似的方法，但他对 4.79 亿个排列进行了采样；)在rcpp 中构建一个循环来评估创建时的排列。这可以节省内存，因为您最终会构建函数以仅返回正确的结果。
用不同的算法解决问题。我将专注于这个选项。
带约束的新算法
段应为 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()and Reduce()here 来做更多的函数式编程——否则，很多代码会被输入六次。有关数学代码的更详尽解释，请参阅原始解决方案。
# 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.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
实际上有960个解决方案。下面我们利用Rcpp、RcppAlgos*和parallel包来获得刚刚超过6 seconds使用 4 个内核的解决方案。即使您选择对基本 R's 使用单线程方法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，我们可以生成排列块并单独测试它们以检查内存。下面，我选择了一次测试大约 470 万个排列。输出给出了 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
现在，我们验证 usingpermuteSample和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
这是另一种方法。它基于Cleve Moler（第一个 MATLAB 的作者） 的MathWorks 博客文章。
在博客文章中，为了节省内存，作者仅排列了 10 个元素，将第一个元素保留为顶点元素，将第 7 个元素保留为基础元素。因此，仅10! == 3628800需要测试排列。
在下面的代码中，
1生成的元素排列10。一共有这样的10! == 3628800。- 选择
11作为顶点元素并保持固定。分配从哪里开始并不重要，其他元素将处于正确的相对位置。 - 然后在循环中将第 12 个元素分配给第 2 个位置、第 3 个位置等
for。
这应该产生大部分的解决方案，给出或采取旋转和反思。但它并不能保证解决方案是唯一的。它也相当快。
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