Para permutações, o rcppalgos é ótimo. Infelizmente, existem 479 milhões de possibilidades com 12 campos, o que significa que consome muita memória para a maioria das pessoas:
library(RcppAlgos)
elements <- 12
permuteGeneral(elements, elements)
#> Error: cannot allocate vector of size 21.4 Gb
Existem algumas alternativas.
Colha uma amostra das permutações. Ou seja, faça apenas 1 milhão em vez de 479 milhões. Para fazer isso, você pode usar permuteSample(12, 12, n = 1e6)
. Veja a resposta de @ JosephWood para uma abordagem um pouco semelhante, exceto que ele obtém 479 milhões de permutações;)
Crie um loop no rcpp para avaliar a permutação na criação. Isso economiza memória porque você acabaria criando a função para retornar apenas os resultados corretos.
Aborde o problema com um algoritmo diferente. Vou me concentrar nessa opção.
Novo algoritmo com restrições
Os segmentos devem ter 26
Sabemos que cada segmento de linha na estrela acima precisa somar 26. Podemos adicionar essa restrição à geração de nossas permutações - nos fornecer apenas combinações que somam 26:
# only certain combinations will add to 26
lucky_combo <- comboGeneral(12, 4, comparisonFun = '==', constraintFun = 'sum', limitConstraints = 26L)
Grupos ABCD e EFGH
Na estrela acima, eu pintei três grupos de maneira diferente: ABCD , EFGH e IJLK . Os dois primeiros grupos também não têm pontos em comum e também estão em segmentos de interesse on-line. Portanto, podemos adicionar outra restrição: para combinações que somam 26, precisamos garantir que ABCD e EFGH não tenham sobreposição de números. Os 4 números restantes serão atribuídos ao IJLK .
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)))
Permissão através dos grupos
Precisamos encontrar todas as permutações de cada grupo. Ou seja, só temos combinações que somam 26. Por exemplo, precisamos pegar 1, 2, 11, 12
e criar 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]
Cálculos finais
O último passo é fazer as contas. Eu uso lapply()
e Reduce()
aqui para fazer uma programação mais funcional - caso contrário, muito código seria digitado seis vezes. Veja a solução original para uma explicação mais completa do código matemático.
# 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
Troca de ABCD e EFGH
No final do código acima, aproveitei a possibilidade de trocar ABCD
e EFGH
obter as permutações restantes. Aqui está o código para confirmar que sim, podemos trocar os dois grupos e estar corretos:
# 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
atuação
No final, avaliamos apenas 1,3 milhão das 479 permutações e apenas embaralhamos apenas 550 MB de RAM. Demora cerca de 0,7s para executar
# 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
e mais importanteL1 <- y[,1] + y[,3] + y[,6] + y[,8]
. Isso não seria realmente ajudar o seu problema de memória para que você pode sempre olhar para rcpp