階乘記憶化中的R

Question

我寫了這個功能找到數

fact <- function(n) { 
    if (n < 0){ 
     cat ("Sorry, factorial does not exist for negative numbers", "\n") 
    } else if (n == 0){ 
     cat ("The factorial of 0 is 1", "\n") 
    } else { 
    results = 1 
    for (i in 1:n){ 
     results = results * i 
    } 
    cat(paste("The factorial of", n ,"is", results, "\n")) 
    } 
} 

現在我想要實現的memoization在R.我有R上的基本理念，並試圖用它們來實現的階乘。但我不確定這是前進的方向。你能不能也請詳細說明這個話題。預先感謝。 Memoized階乘所有的

fact_tbl <- c(0, 1, rep(NA, 100)) 
    fact_mem <- function(n){ 
      stopifnot(n > 0) 
      if(!is.na(fib_tbl[n])){ 
      fib_tbl[n] 
    } else { 
     fact_tbl[n-1] <<- fac_mem(n-1) * n 
    } 
    } 

    print (fact_mem(4)) 

Answer 1

首先，如果你需要一個有效的實施，使用r的factorial功能。不要自己寫。然後，階乘是一個很好的鍛鍊理解遞歸：

myfactorial <- function(n) { 
    if (n == 1) return(1) 
    n * myfactorial(n-1) 
} 

myfactorial(10) 
#[1] 3628800 

有了這個功能記憶化是唯一有用的，如果你打算重複使用的功能。您可以使用閉包在R中實現記憶。哈德利在his book解釋這些。

createMemFactorial <- function() { 
    res <- 1 
    memFactorial <- function(n) { 
    if (n == 1) return(1) 

    #grow res if necessary 
    if (length(res) < n) res <<- `length<-`(res, n) 

    #return pre-calculated value 
    if (!is.na(res[n])) return(res[n]) 

    #calculate new values 
    res[n] <<- n * factorial(n-1) 
    res[n] 
    } 
    memFactorial 
} 
memFactorial <- createMemFactorial() 

memFactorial(10) 
#[1] 3628800 

它實際上是否更快？

library(microbenchmark) 
microbenchmark(factorial(10), 
       myfactorial(10), 
       memFactorial(10)) 
#Unit: nanoseconds 
#    expr min  lq mean median  uq max neval cld 
# factorial(10) 235 264.0 348.02 304.5 378.5 2463 100 a 
# myfactorial(10) 4799 5279.5 6491.94 5629.0 6044.5 15955 100 c 
# memFactorial(10) 950 1025.0 1344.51 1134.5 1292.0 7942 100 b 

注意microbenchmark評估函數（默認）的100倍。由於在測試memFactorial時我們已經存儲了n = 10的值，因此我們只計算if條件和查找。正如你所看到的，R的實現主要用C語言編寫，速度更快。

一個更好（更容易）的例子實現斐波那契數。這裏算法本身受益於記憶。

#naive recursive implementation 
fib <- function(n) { 
    if(n == 1 || n == 2) return(1) 
    fib(n-1) + fib(n-2) 
} 

#with memoization 
fibm <- function(n) { 
    if(n == 1 || n == 2) return(1) 

    seq <- integer(n) 
    seq[1:2] <- 1 

    calc <- function(n) { 
    if (seq[n] != 0) return(seq[n]) 
    seq[n] <<- calc(n-1) + calc(n-2) 
    seq[n] 
    } 

    calc(n) 
} 

#try it: 
fib(20) 
#[1] 6765 
fibm(20) 
#[1] 6765 

#Is memoization faster? 
microbenchmark(fib(20), 
       fibm(20)) 
#Unit: microseconds 
#  expr  min  lq  mean median  uq  max neval cld 
# fib(20) 8005.314 8804.130 9758.75325 9301.6210 9798.8500 46867.182 100 b 
#fibm(20) 38.991 44.798 54.12626 53.6725 60.4035 97.089 100 a