順列については、rcppalgosが最適です。残念ながら、12のフィールドには4億7700万の可能性があります。これは、ほとんどの人にとってメモリを消費しすぎることを意味します。
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
いくつかの選択肢があります。
順列のサンプルを取ります。つまり、4億7700万の代わりに100万を実行するだけです。これを行うには、を使用できますpermuteSample(12, 12, n = 1e6)。4億7700万の順列にサンプリングすることを除いて、多少似たアプローチについては@JosephWoodの回答を参照してください;）
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の 3つのグループに異なる色を付けています。最初の2つのグループにも共通点はなく、関心のある線分上にあります。したがって、別の制約を追加できます。合計が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()ここを使用して、より関数型のプログラミングを行います。そうしないと、多くのコードが6回入力されます。数学コードの詳細については、元のソリューションを参照してください。
# 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て残りの順列を取得できることを利用しました。以下は、はい、2つのグループを入れ替えて正しいことを確認できるコードです。
# 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
x<- 1:elementsそしてもっと重要なことL1 <- y[,1] + y[,3] + y[,6] + y[,8]。これは実際にはメモリの問題には役立ちませんので、いつでもrcppを