2015-04-27 16 views
7

Ví dụ, hãy xem xét số 96. Nó có thể được viết bằng những cách sau đây:R Thuật toán để tạo ra tất cả factorizations có thể của một số

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 

Tôi biết điều này có liên quan đến phân vùng như bất kỳ số văn bản như sức mạnh , n, của một số nguyên tố, p, chỉ đơn giản là số cách bạn có thể viết n. Ví dụ: để tìm tất cả các thừa số của 2^5, chúng tôi phải tìm tất cả các cách để viết 5. Chúng là:

  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

Tôi đã tìm thấy một bài viết tuyệt vời của Jerome Kelleher về thuật toán tạo phân vùng here. Tôi đã thích nghi một trong những thuật toán python của mình để R. Đoạn mã dưới:

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 
} 

Tôi đã cố gắng để mở rộng phương pháp này để số với hơn một hơn một yếu tố quan trọng, nhưng mã của tôi trở nên rất vụng về. Sau khi đấu vật với ý tưởng này một lúc, tôi quyết định thử một con đường khác. Thuật toán mới của tôi không sử dụng phân vùng tạo nào. Nó là một thuật toán "tra cứu" tận dụng lợi thế của các yếu tố đã được tạo ra. Mã bên dưới:

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 
} 

Hàm đầu tiên trong mã trên chỉ đơn giản là hàm tạo ra tất cả các yếu tố. Đây là mã nếu bạn tò mò:

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 
} 

thuật toán của tôi chỉ là okay nếu bạn chỉ quan tâm đến số dưới 10.000 (nó tạo ra tất cả factorizations cho mỗi số < = 10.000 trong khoảng 17 giây), nhưng nó chắc chắn không mở rộng tốt. Tôi muốn tìm một thuật toán có cùng một tiền đề tạo ra một danh sách tất cả các thừa số cho mỗi số nhỏ hơn hoặc bằng n vì một số ứng dụng tôi có trong tâm trí sẽ tham chiếu một hệ số đã cho nhiều lần, do đó có nó trong một danh sách nên nhanh hơn tạo ra nó trên bay mọi lúc (tôi biết có một chi phí bộ nhớ ở đây).

+1

Đây không phải là một vấn đề đơn giản (rõ ràng) nhưng trong trường hợp bạn chưa tìm thấy nó, đây là mục có liên quan từ Bách khoa toàn thư trực tuyến của chuỗi số nguyên: https://oeis.org/A001055 –

+0

Đây là rất hữu ích, mặc dù điều này chỉ cho tổng số các thừa số và không phải là các yếu tố thực tế. Ví dụ, đối với n = 96 như trên, nó mang lại cho 19. –

Trả lời

5

Chức năng của bạn EfficientFactorList thực hiện tốt công việc lấy tập hợp tất cả các yếu tố cho mỗi số từ 1 đến n, vì vậy tất cả những gì còn lại là nhận được tập hợp tất cả các yếu tố. Như bạn đề xuất, việc sử dụng các thừa số của các giá trị nhỏ hơn để tính toán các thừa số cho các giá trị lớn hơn có vẻ như nó có thể hiệu quả.

Xem xét một số k, với các yếu tố k_1, k_2, ..., k_n. Một cách tiếp cận ngây thơ sẽ là kết hợp các thừa số của k/k_1, k/k_2, ..., k/k_n, thêm k_i vào mỗi hệ số k/k_i để sinh ra hệ số k. Như một ví dụ làm việc, hãy xem xét tính toán các thừa số của 16 (trong đó có các yếu tố không tầm thường 2, 4 và 8).2 có hệ số hóa {2}, 4 có các thừa số {4, 2 * 2} và 8 có các thừa số {8, 4 * 2, 2 * 2 * 2}, vì vậy chúng tôi sẽ tính toán tập hợp đầy đủ các thừa số của máy tính đầu tiên {2 * 8, 4 * 4, 2 * 2 * 4, 8 * 2, 4 * 2 * 2, 2 * 2 * 2 * 2} và sau đó lấy các yếu tố duy nhất, {8 * 2, 4 * 4, 4 * 2 * 2, 2 * 2 * 2 * 2}. Thêm 16 sản lượng câu trả lời cuối cùng.

Cách tiếp cận hiệu quả hơn là lưu ý rằng chúng tôi không cần nối thêm k_i vào tất cả các thừa số của k/k_i. Ví dụ, chúng ta không cần thêm 2 * 2 * 4 từ hệ số 4 vì nó đã được bao gồm từ hệ số 8. Tương tự, chúng ta không cần thêm 2 * 8 từ hệ số 2 bởi vì điều này đã được bao gồm từ yếu tố của 8. Nói chung, chúng ta chỉ cần bao gồm một yếu tố từ k/k_i nếu tất cả các giá trị trong hệ số này là k_i hoặc lớn hơn.

Trong mã:

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

Đây là một thỏa thuận tốt nhanh hơn so với mã đăng:

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 

Là một kiểm tra sanity, nó cũng trả về cùng một số factorizations cho mỗi số:

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

Thực hiện R thực sự tốt đẹp! Một quan sát nhỏ: trong hàm do.call gần phía dưới, chữ "c" phải là một chuỗi tức là do.call ("c", allSmaller) –

+0

Mã này cũng quy mô tốt hơn so với của tôi. all.fact (20000) chỉ mất khoảng 3 giây, trong khi tôi mất gần 50 giây. Tuyệt vời!! –

+1

@JosephWood lại nhận xét đầu tiên của bạn, có lý do nào bạn đề xuất không? 'do.call (c, list (1, 2, 3))' trả về cùng một thứ như 'do.call (" c ", list (1, 2, 3))' và lưu hai tổ hợp phím. Tôi thấy từ '? Do.call' mà họ sử dụng cả hai, nhưng nó dường như chỉ quan trọng khi bạn xác định các môi trường (mà chúng tôi không làm ở đây). – josliber

0

Trong trường hợp ai đó quan tâm đến việc tạo phân vùng nhân cho một số r n, dưới đây là hai thuật toán mà sẽ làm việc đó (chức năng IntegerPartition xuất phát từ câu hỏi ở trên):

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 
} 

Dưới đây là mã josliber từ trên thao tác để xử lý một trường hợp duy nhất. Hàm MyFactors xuất phát từ số post (nó trả về tất cả các thừa số của một số đã cho).

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

Dưới đây là một số tiêu chuẩn:

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 

Mặc dù get_Factorizations1 là nhanh hơn, phương pháp thứ hai là trực quan hơn (xem giải thích tuyệt vời josliber của trên) và nó tạo ra một đối tượng nhỏ hơn. Đối với người đọc quan tâm, here là một bài báo thực sự hay về chủ đề này.

Các vấn đề liên quan