Pour les permutations, rcppalgos est génial. Malheureusement, il y a 479 millions de possibilités avec 12 champs, ce qui signifie que cela prend trop de mémoire pour la plupart des gens:
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
Il existe quelques alternatives.
Prenez un échantillon des permutations. Ce qui signifie, ne faites que 1 million au lieu de 479 millions. Pour ce faire, vous pouvez utiliser permuteSample(12, 12, n = 1e6)
. Voir la réponse de @ JosephWood pour une approche quelque peu similaire, sauf qu'il échantillonne jusqu'à 479 millions de permutations;)
Construisez une boucle dans rcpp pour évaluer la permutation à la création. Cela économise de la mémoire car vous finiriez par créer la fonction pour ne renvoyer que les résultats corrects.
Abordez le problème avec un algorithme différent. Je vais me concentrer sur cette option.
Nouvel algorithme avec contraintes
Les segments doivent être 26
Nous savons que chaque segment de ligne dans l'étoile ci-dessus doit totaliser jusqu'à 26. Nous pouvons ajouter cette contrainte pour générer nos permutations - ne nous donnez que des combinaisons qui totalisent jusqu'à 26:
# only certain combinations will add to 26
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)
ABCD et EFGHGroupes
Dans l'étoile ci-dessus, j'ai coloré trois groupes différemment: ABCD , EFGH et IJLK . Les deux premiers groupes n'ont pas non plus de points communs et sont également des segments d'intérêt en ligne. Par conséquent, nous pouvons ajouter une autre contrainte: pour les combinaisons totalisant jusqu'à 26, nous devons nous assurer que ABCD et EFGH ne se chevauchent pas. IJLK se verra attribuer les 4 numéros restants.
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)))
Permutez à travers les groupes
Nous devons trouver toutes les permutations de chaque groupe. Autrement dit, nous n'avons que des combinaisons qui totalisent jusqu'à 26. Par exemple, nous devons prendre 1, 2, 11, 12
et faire 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]
Calculs finaux
La dernière étape consiste à faire le calcul. J'utilise lapply()
et Reduce()
ici pour faire une programmation plus fonctionnelle - sinon, beaucoup de code serait tapé six fois. Voir la solution d'origine pour une explication plus approfondie du code mathématique.
# 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
Échange ABCD et EFGH
À la fin du code ci-dessus, j'ai profité du fait que nous pouvons échanger ABCD
et EFGH
obtenir les permutations restantes. Voici le code pour confirmer que oui, nous pouvons échanger les deux groupes et être correct:
# 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
Performance
Au final, nous n'avons évalué que 1,3 million des 479 permutations et seulement mélangé sur 550 Mo de RAM. Il faut environ 0,7 secondes pour fonctionner
# 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
et plus important encoreL1 <- y[,1] + y[,3] + y[,6] + y[,8]
. Cela n'aiderait pas vraiment votre problème de mémoire, vous pouvez donc toujours regarder dans rcpp