R algoritmas generuoti visus galimus faktorizacijos numerius

Pavyzdžiui, apsvarstykite numerį 96. Jis gali būti parašytas šiais būdais:

 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 

Žinau, kad tai yra susiję su sekcijomis, nes bet kuris skaičius, parašytas kaip galia, n , vienas pirminis skaičius, p , yra tiesiog būdas, kuriuo galite rašyti <i> n. Pavyzdžiui, norėdami rasti visus 2 ^ 5 faktorius, turime rasti visus būdus, kaip rašyti 5. Jie:

  • 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

Čia rado nuostabų Jerome Keller straipsnį apie skaidinių generavimo algoritmus. Aš pritaikiau vieną iš savo python algoritmų į R. Šis kodas:

 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 <- yx; k <- k+1L} a[k] <- x+y count <- count+1L MyParts[[count]] <- a[1L:k] } MyParts } 

Bandžiau išplėsti šį metodą su skaičiais, turinčiais daugiau nei vieną paprastą veiksnį, tačiau mano kodas tapo labai sudėtingas. Po ilgos kovos su šia idėja nusprendžiau išbandyti kitą maršrutą. Mano naujasis algoritmas visai nenaudoja skaidinio generavimo. Tai yra „atvirkštinės peržiūros“ algoritmas, kuris pasinaudoja jau sukauptais faktoriais. Toliau pateikiamas kodas:

 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 } 

Pirmoji minėto kodo funkcija yra tik funkcija, kuri sukuria visus veiksnius. Štai kodas, jei domitės:

 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 } 

Mano algoritmas yra gerai, jei jus domina tik mažesni nei 10 000 numeriai (jis generuoja visus faktorius kiekvienam skaičiui <= 10 000 maždaug 17 sekundžių), tačiau jis tikrai nėra masto. Norėčiau rasti algoritmą, turintį tokią pačią prielaidą, kad būtų sudarytas visų faktorių sąrašas kiekvienam skaičiui, kuris yra mažesnis arba lygus n , nes kai kurios programos, kurias aš turiu omenyje, šį faktorių nurodys vieną kartą, todėl sąrašas turėtų būti būkite greičiau, nei kiekvieną kartą jį generuojate skristi (aš žinau, kad atmintis yra verta).

7
27 апр. nustatė Joseph Wood balandžio 27 d 2015-04-27 23:39 '15, 11:39, 2015-04-27 23:39
@ 2 atsakymai

Jūsų „ EfficientFactorList funkcija puikiai padeda užfiksuoti visų faktorių rinkinį kiekvienam skaičiui nuo 1 iki n, taigi viskas, kas lieka, yra visų faktorizacijų rinkinys. Jūsų nuomone, naudojant mažesnių verčių faktorizaciją, norint apskaičiuoti faktorius didelėms vertėms, yra panašus į faktą, kad jis gali būti veiksmingas.

Apsvarstykite skaičių k su koeficientais k_1, k_2, ..., k_n. Naivus požiūris būtų sujungti k / k_1, k / k_2, ..., k / k_n faktorizacijas, pridedant k_i kiekvienam k / k_i faktorizavimui, kad gautumėte faktorizaciją k. Kaip apdorotą pavyzdį, apsvarstykite 16 faktorizacijų skaičiavimą (kuris turi netiesioginius koeficientus 2, 4 ir 8). 2 turi faktorizaciją {2}, 4 turi faktorizaciją {4, 2 * 2}, ir 8 turi faktorizaciją {8, 4 * 2, 2 * 2 * 2}, todėl apskaičiavome pilną faktorizaciją, nustatytą pirmuoju skaičiavimu {2 * 8, 4 * 4, 2 * 2 * 4, 8 * 2, 4 * 2 * 2, 2 * 2 * 2 * 2}, tada priimdami unikalius faktorius, {8 * 2, 4 * 4, 4 * 2 * 2, 2 * 2 * 2 * 2}. 16 priede pateikiamas galutinis atsakymas.

Veiksmingesnis požiūris yra pažymėti, kad mums nereikia pridėti k_i į visus k / k_i veiksnius. Pavyzdžiui, mes neturėjome pridėti 2 * 2 * 4 iš 4 faktoringo, nes jis jau įtrauktas į faktorizaciją 8. Taip pat nereikėjo pridėti 2 * 8 iš 2 faktorizacijos, nes jis jau įtrauktas į faktorizaciją 8. Iš esmės mes turime įgalinti faktorizavimą iš k / k_i, jei visos faktorizacijos vertės yra k_i ar daugiau.

Kode:

 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) } 

Tai daug greičiau nei paskelbtas kodas:

 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 

Kaip sveikatos patikrinimą, jis taip pat grąžina tiek daug faktorių kiekvienam skaičiui:

 lf1 <- sapply(f1, length) lf2 <- sapply(f2, length) all.equal(lf1, lf2) # [1] TRUE 
5
28 апр. atsakymas pateikiamas josliber 28 d. 2015-04-28 00:34 '15 prie 0:34 2015-04-28 00:34

Tuo atveju, jei kas nors domina sukurti daugiafunkcinius skirsnius vienam numeriui n, žemiau yra du algoritmai, kurie tai padarys ( IntegerPartition funkcija eina iš pirmiau pateikto klausimo):

 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 } 

Žemiau yra viršutinis josliberio kodas, kuris apdorojamas tvarkant vieną atvejį. „ MyFactors funkcija gaunama iš šio pranešimo (jis grąžina visus tam tikro skaičiaus veiksnius).

 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]] } 

Štai keli žingsniai:

 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 

Net jei get_Factorizations1 yra greitesnis, antrasis metodas yra intuityvesnis (žr. Aukščiau pateiktą josliber paaiškinimą) ir sukuria mažesnį objektą. Suinteresuotam skaitytojui čia yra tikrai geras straipsnis.

0
10 мая '16 в 22:51 2016-05-10 22:51 Joseph Wood atsakymas gegužės 10 d., 16 d., 10:51 pm 2016-05-10 22:51

Žr. Kitus klausimus apie žymes arba Užduoti klausimą