R algoritmo per generare tutti i possibili fattorizzazione di un numero

Question

Ad esempio, si consideri il numero 96. Esso può essere scritto in modi seguenti:

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 

So che questo è legato alle partizioni qualsiasi numero scritto come il potere , n., di un singolo primo, p, è semplicemente il numero di modi in cui è possibile scrivere n. Ad esempio, per trovare tutte le fattorizzazioni di 2^5, dobbiamo trovare tutti i modi per scrivere 5. Essi sono:

1. 1 + 1 + 1 + 1 + 1 == >> 2^1 * 2^1 * 2^1 * 2^1 * 2^1
2. 1 + 1 + 1 + 2 == >> 2^1 * 2^1 * 2^1 * 2^2
3. 1 + 1 + 3 == >> 2^1 * 2^1 * 2^3
4. 1 + 2 + 2 == >> 2^1 * 2^2 * 2^2
5. 1 + 4 == >> 2^1 * 2^4
6. 2 + 3 == >> 2^2 * 2^3
7. 5 == >> 2^5

Ho trovato un articolo meraviglioso di Jerome Kelleher sugli algoritmi di generazione delle partizioni here. Ho adattato uno dei suoi algoritmi di Python per R. Il codice è qui sotto:

library(partitions) ## using P(n) to determine number of partitions of an integer 
IntegerPartitions <- function(n) { 
    a <- 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 
} 

ho tentato di estendere questo metodo per i numeri con più uno che un fattore primario, ma il mio codice ottenuto molto goffo. Dopo aver lottato con questa idea per un po ', ho deciso di provare una strada diversa. Il mio nuovo algoritmo non fa uso di generare partizioni di sorta. È più un algoritmo di "lookback" che sfrutta le fatture che sono già state generate. Il codice è qui sotto:

FactorRepresentations <- function(n) { 

MyFacts <- EfficientFactorList(n) 
MyReps <- lapply(1:n, function(x) x) 

    for (k in 4:n) { 
     if (isprime(k)) {next} 
     myset <- MyFacts[[k]] 
     mylist <- vector("list") 
     mylist[[1]] <- k 
     count <- 1L 
      for (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) { 
        for (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 
} 

La prima funzione nel codice sopra è semplicemente una funzione che genera tutti i fattori. Ecco il codice se siete curiosi:

EfficientFactorList <- function(n) { 
    MyFactsList <- lapply(1:n, function(x) 1) 
    for (j in 2:n) { 
     for (r in seq.int(j, n, j)) {MyFactsList[[r]] <- c(MyFactsList[[r]], j)} 
    } 
    MyFactsList 
} 

mio algoritmo è solo bene se siete interessati solo con i numeri di meno di 10.000 (che genera tutte le fattorizzazioni per ogni numero < = 10.000 in circa 17 secondi), ma sicuramente non scala bene. Mi piacerebbe trovare un algoritmo che abbia la stessa premessa di generare un elenco di fatture per ogni numero minore o uguale a n poiché alcune delle applicazioni che ho in mente faranno riferimento a una data fattorizzazione più volte, avendo così in una lista dovrebbe essere più veloce di generarlo al volo ogni volta (so che qui c'è un costo di memoria).

Answer 1

La funzione EfficientFactorList fa un buon lavoro per ottenere in modo efficiente l'insieme di tutti i fattori per ogni numero da 1 a n, quindi tutto ciò che rimane è ottenere l'insieme di tutte le fatture. Come suggerisci, l'uso delle fatture di valori più piccoli per calcolare le fatture per valori più grandi sembra che potrebbe essere efficiente.

Considerare un numero k, con fattori k_1, k_2, ..., k_n. Un approccio ingenuo sarebbe quello di combinare le fatture di k/k_1, k/k_2, ..., k/k_n, aggiungendo k_i ad ogni fattorizzazione di k/k_i per produrre una fattorizzazione di k. Come esempio pratico, considera il calcolo delle fatture di 16 (che ha fattori non banali 2, 4 e 8).2 ha fattorizzazione {2}, 4 ha fattorizzazioni {4, 2 * 2}, e 8 ha fattorizzazioni {8, 4 * 2, 2 * 2 * 2}, quindi calcoleremo il set completo di fattorizzazioni prima calcolando {2 * 8, 4 * 4, 2 * 2 * 4, 8 * 2, 4 * 2 * 2, 2 * 2 * 2 * 2} e poi prendendo le singole fatture, {8 * 2, 4 * 4, 4 * 2 * 2, 2 * 2 * 2 * 2}. L'aggiunta di 16 produce la risposta finale.

Un approccio più efficiente è notare che non è necessario aggiungere k_i a tutte le fatture di k/k_i. Ad esempio, non abbiamo bisogno di aggiungere 2 * 2 * 4 dalla fattorizzazione di 4 perché questo è già incluso nella fattorizzazione di 8. Allo stesso modo, non abbiamo bisogno di aggiungere 2 * 8 dalla fattorizzazione di 2 perché questo è già incluso dalla fattorizzazione di 8. In generale, abbiamo solo bisogno di includere una fattorizzazione da k/k_i se tutti i valori nella fattorizzazione sono k_i o maggiori.

in codice:

library(gmp) 
all.fact <- function(n) { 
    facts <- EfficientFactorList(n) 
    facts[[1]] <- list(1) 
    for (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) 
} 

Questo è un buon affare più veloce rispetto al codice scritto:

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 

Come un controllo di integrità, restituisce anche lo stesso numero di fattorizzazione per ogni numero:

lf1 <- sapply(f1, length) 
lf2 <- sapply(f2, length) 
all.equal(lf1, lf2) 
# [1] TRUE 

Answer 2

Nel caso in cui qualcuno sia interessato a generare le partizioni moltiplicative per un numbe r n, di seguito sono due algoritmi che farà proprio questo (la funzione IntegerPartition proviene dalla domanda di cui sopra):

library(gmp) 
library(partitions) 
get_Factorizations1 <- function(MyN) { 
    pfs <- function (x1) { 
     n1 <- length(x1) 
     y1 <- x1[-1L] != x1[-n1] 
     i <- c(which(y1), n1) 
     list(lengths = diff(c(0L, i)), values = x1[i], uni = sum(y1)+1L) 
    } 

    if (MyN==1L) return(MyN) 
    else { 
     pfacs <- pfs(as.integer(factorize(MyN))) 
     unip <- pfacs$values 
     pv <- pfacs$lengths 
     n <- pfacs$uni 
     mySort <- order(pv, decreasing = TRUE) 
     pv <- pv[mySort] 
     unip <- unip[mySort] 
     myReps <- lapply(IntegerPartitions(pv[1L]), function(y) unip[1L]^y) 
     if (n > 1L) { 
      mySet <- unlist(lapply(2L:n, function(x) rep(unip[x],pv[x]))) 
      for (p in mySet) { 
       myReps <- unique(do.call(c, 
        lapply(myReps, function(j) { 
         dupJ <- duplicated(j) 
         nDupJ <- !dupJ 
         SetJ <- j[which(nDupJ)] 
         lenJ <- sum(nDupJ) 
         if (any(dupJ)) {v1 <- j[which(dupJ)]} else {v1 <- vector(mode="integer")} 
         tList <- vector("list", length=lenJ+1L) 
         tList[[1L]] <- sort(c(j,p)) 

         if (lenJ > 1L) {c2 <- 1L 
          for (a in 1:lenJ) {tList[[c2 <- c2+1L]] <- sort(c(v1,SetJ[-a],SetJ[a]*p))} 
         } else { 
          tList[[2L]] <- sort(c(v1,p*SetJ)) 
         } 
         tList 
        } 
       ))) 
      } 
     } 
    } 
    myReps 
} 

seguito è il codice di josliber dall'alto manipolato per gestire un singolo caso. La funzione MyFactors proviene da questo post (restituisce tutti i fattori di un determinato numero).

library(gmp) 
get_Factorizations2 <- function(n) { 
    myFacts <- as.integer(MyFactors(n)) 
    facts <- lapply(myFacts, function(x) 1L) 
    numFacs <- length(myFacts) 
    facts[[numFacs]] <- myFacts 
    names(facts) <- facts[[numFacs]] 
    for (j in 2L:numFacs) { 
     x <- myFacts[j] 
     if (isprime(x)>0L) { 
      facts[[j]] <- list(x) 
     } else { 
      facts[[j]] <- myFacts[which(x%%myFacts[myFacts <= x]==0L)] 
      x.facts <- facts[[j]][facts[[j]] != 1 & facts[[j]] <= (x^0.5+0.001)] 
      allSmaller <- lapply(x.facts, function(pf) lapply(facts[[which(names(facts)==(x/pf))]], function(y) { 
       if (all(y >= pf)) { 
        return(c(pf, y)) 
       } else { 
        return(NULL) 
       } 
      })) 
      allSmaller <- do.call(c, allSmaller) 
      facts[[j]] <- c(x, allSmaller[!sapply(allSmaller, function(y) is.null(y))]) 
     } 
    } 
    facts[[numFacs]] 
} 

Ecco alcuni parametri:

set.seed(101) 
samp <- sample(10^7, 10^4) 
library(rbenchmark) 
benchmark(getFacs1=sapply(samp, get_Factorizations), 
      getFacs2=sapply(samp, get_Factorizations2), 
      replications=5, 
      columns = c("test", "replications", "elapsed", "relative"), 
      order = "relative") 
test replications elapsed relative 
1 getFacs1   5 117.68 1.000 
2 getFacs2   5 216.39 1.839 


system.time(t2 <- get_Factorizations(25401600)) 
user system elapsed 
10.89 0.03 10.97 
system.time(t2 <- get_Factorizations2(25401600)) 
user system elapsed 
21.08 0.00 21.12 

length(t1)==length(t2) 
[1] TRUE 

object.size(t1) 
28552768 bytes 
object.size(t2) 
20908768 bytes 

Anche se get_Factorizations1 è più veloce, il secondo metodo è più intuitivo (vedi spiegazione eccellente del josliber sopra) e si produce un oggetto più piccolo. Per il lettore interessato, here è davvero un ottimo articolo sull'argomento.