for example, consider number 96. can written in following ways:
1. 96 2. 48 * 2 3. 24 * 2 * 2 4. 12 * 2 * 2 * 2 5. 6 * 2 * 2 * 2 * 2 6. 3 * 2 * 2 * 2 * 2 * 2 7. 4 * 3 * 2 * 2 * 2 8. 8 * 3 * 2 * 2 9. 6 * 4 * 2 * 2 10. 16 * 3 * 2 11. 4 * 4 * 3 * 2 12. 12 * 4 * 2 13. 8 * 6 * 2 14. 32 * 3 15. 8 * 4 * 3 16. 24 * 4 17. 6 * 4 * 4 18. 16 * 6 19. 12 * 8 i know related partitions number written power, n, of single prime, p, number of ways can write n. example, find of factorizations of 2^5, must find ways write 5. are:
- 1+1+1+1+1 ==>> 2^1 * 2^1 * 2^1 * 2^1 * 2^1
- 1+1+1+2 ==>> 2^1 * 2^1 * 2^1 * 2^2
- 1+1+3 ==>> 2^1 * 2^1 * 2^3
- 1+2+2 ==>> 2^1 * 2^2 * 2^2
- 1+4 ==>> 2^1 * 2^4
- 2+3 ==>> 2^2 * 2^3
- 5 ==>> 2^5
i found wonderful article jerome kelleher partition generating algorithms here. have adapted 1 of python algorithms r. code below:
library(partitions) ## using p(n) determine number of partitions of integer integerpartitions <- function(n) { <- 0l:n k <- 2l a[2l] <- n myparts <- vector("list", length=p(n)) count <- 0l while (!(k==1l)) { x <- a[k-1l]+1l y <- a[k]-1l k <- k-1l while (x<=y) {a[k] <- x; y <- y-x; k <- k+1l} a[k] <- x+y count <- count+1l myparts[[count]] <- a[1l:k] } myparts } i attempted extend method numbers more 1 1 prime factor, code got clunky. after wrestling idea while, decided try different route. new algorithm makes no use of generating partitions whatsoever. more of "lookback" algorithm takes advantage of factorizations have been generated. code below:
factorrepresentations <- function(n) { myfacts <- efficientfactorlist(n) myreps <- lapply(1:n, function(x) x) (k in 4:n) { if (isprime(k)) {next} myset <- myfacts[[k]] mylist <- vector("list") mylist[[1]] <- k count <- 1l (j in 2:ceiling(length(myset)/2)) { count <- count+1l temp <- as.integer(k/myset[j]) myvec <- sort(c(myset[j], temp), decreasing=true) mylist[[count]] <- myvec mytemprep <- myreps[[temp]] if (isprime(temp) || temp==k) {next} if (length(mytemprep)>1) { (i in 1:length(mytemprep)) { count <- count+1l myvec <- sort(c(myset[j], mytemprep[[i]]), decreasing=true) mylist[[count]] <- myvec } } } myreps[[k]] <- unique(mylist) } myreps } the first function in code above function generates factors. here code if curious:
efficientfactorlist <- function(n) { myfactslist <- lapply(1:n, function(x) 1) (j in 2:n) { (r in seq.int(j, n, j)) {myfactslist[[r]] <- c(myfactslist[[r]], j)} } myfactslist } my algorithm okay if concerned numbers less 10,000 (it generates factorizations every number <= 10,000 in 17 seconds), doesn't scale well. find algorithm has same premise of generating list of factorizations every number less or equal n of applications have in mind reference given factorization multiple times, having in list should faster generating on fly everytime (i know there memory cost here).
your function efficientfactorlist job of efficiently grabbing set of factors each number 1 n, remains getting set of factorizations. suggest, using factorizations of smaller values compute factorizations larger values seems efficient.
consider number k, factors k_1, k_2, ..., k_n. naive approach combine factorizations of k/k_1, k/k_2, ..., k/k_n, appending k_i each factorization of k/k_i yield factorization of k. worked example, consider computing factorizations of 16 (which has non-trivial factors 2, 4, , 8). 2 has factorization {2}, 4 has factorizations {4, 2*2}, , 8 has factorizations {8, 4*2, 2*2*2}, compute full set of factorizations first computing {2*8, 4*4, 2*2*4, 8*2, 4*2*2, 2*2*2*2} , taking unique factorizations, {8*2, 4*4, 4*2*2, 2*2*2*2}. adding 16 yields final answer.
a more efficient approach notice don't need append k_i factorizations of k/k_i. instance, didn't need add 2*2*4 factorization of 4 because included factorization of 8. similarly, didn't need add 2*8 factorization of 2 because included factorization of 8. in general, need include factorization k/k_i if values in factorization k_i or greater.
in code:
library(gmp) all.fact <- function(n) { facts <- efficientfactorlist(n) facts[[1]] <- list(1) (x in 2:n) { if (length(facts[[x]]) == 2) { facts[[x]] <- list(x) # prime number } else { x.facts <- facts[[x]][facts[[x]] != 1 & facts[[x]] <= (x^0.5+0.001)] allsmaller <- lapply(x.facts, function(pf) lapply(facts[[x/pf]], function(y) { if (all(y >= pf)) { return(c(pf, y)) } else { return(null) } })) allsmaller <- do.call(c, allsmaller) facts[[x]] <- c(x, allsmaller[!sapply(allsmaller, function(y) is.null(y))]) } } return(facts) } this deal quicker posted code:
system.time(f1 <- factorrepresentations(10000)) # user system elapsed # 13.470 0.159 13.765 system.time(f2 <- all.fact(10000)) # user system elapsed # 1.602 0.028 1.641 as sanity check, returns same number of factorizations each number:
lf1 <- sapply(f1, length) lf2 <- sapply(f2, length) all.equal(lf1, lf2) # [1] true 