我的递归函数在R中为什么如此缓慢？

Question

我的递归函数在R中为什么如此缓慢？

algorithmroptimizationrecursionfibonacci

22

以下代码需要约30秒运行，而我希望它几乎是即时的。我的代码有问题吗？

x <- fibonacci(35);

fibonacci <- function(seq) {
    if (seq == 1) return(1);
    if (seq == 2) return(2);
    return (fibonacci(seq - 1) + fibonacci(seq - 2));
}

- deltanovember

5

记忆化在哪里？ - Ignacio Vazquez-Abrams

除了如上所述实现更好的算法外，您还可以尝试Radford Neal正在开发的一些R补丁。http://radfordneal.wordpress.com/2010/09/03/fourteen-patches-to-speed-up-r/ - Ari B. Friedman

1

我不确定你的问题是什么，但是你确定你正在正确实现斐波那契数列吗？你的代码将会生成 1,2,3,5,8,...，然而正确的数列应该是 0,1,1,2,3,5,8,...。 - Peter K.

不熟悉记忆化及其在R中的实现。我正在按照此处指定的方式实现斐波那契数列：http://projecteuler.net/index.php?section=problems&id=2 - deltanovember

包gmp具有函数fibnum，可计算任意精度的斐波那契数。使用标准的doubles只能获得最多n=55左右的值。 - Ferdinand.kraft

7个回答

27

这仅仅提供了一个很好的机会来推广Rcpp，它允许我们轻松地将C++函数添加到R中。

所以在稍微修正代码并使用inline（用于将短代码片段编译、加载和链接为动态可加载函数）和rbenchmark包对函数进行计时和比较后，我们以惊人的700倍性能提升结束：

R> print(res)
        test replications elapsed relative user.self sys.self
2 fibRcpp(N)            1   0.092    1.000      0.10        0
1    fibR(N)            1  65.693  714.054     65.66        0
R>

这里我们看到92毫秒对比65秒的流逝时间，相对比例为714。但是现在其他人都告诉您不要直接在R中进行此操作……以下是代码。

## inline to compile, load and link the C++ code
require(inline)

## we need a pure C/C++ function as the generated function
## will have a random identifier at the C++ level preventing
## us from direct recursive calls
incltxt <- '
int fibonacci(const int x) {
   if (x == 0) return(0);
   if (x == 1) return(1);
   return (fibonacci(x - 1)) + fibonacci(x - 2);
}'

## now use the snipped above as well as one argument conversion
## in as well as out to provide Fibonacci numbers via C++
fibRcpp <- cxxfunction(signature(xs="int"),
                   plugin="Rcpp",
                   incl=incltxt,
                   body='
   int x = Rcpp::as<int>(xs);
   return Rcpp::wrap( fibonacci(x) );
')

## for comparison, the original (but repaired with 0/1 offsets)
fibR <- function(seq) {
    if (seq == 0) return(0);
    if (seq == 1) return(1);
    return (fibR(seq - 1) + fibR(seq - 2));
}

## load rbenchmark to compare
library(rbenchmark)

N <- 35     ## same parameter as original post
res <- benchmark(fibR(N),
                 fibRcpp(N),
                 columns=c("test", "replications", "elapsed",
                           "relative", "user.self", "sys.self"),
                 order="relative",
                 replications=1)
print(res)  ## show result

为了完整起见，这些函数还会生成正确的输出：

R> sapply(1:10, fibR)
 [1]  1  1  2  3  5  8 13 21 34 55
R> sapply(1:10, fibRcpp)
 [1]  1  1  2  3  5  8 13 21 34 55
R>

- Dirk Eddelbuettel

嗯，Rcpp... 看起来真的很好用和简单啊！不错；-) 你似乎还试图证明指数算法的合理性呢 ;) - Tomas

1

哦，编译后代码只用了92毫秒，它似乎没有实现指数算法，即使在快速计算机上也是如此。编译器一定以某种聪明的方式进行了优化。我认为这不是一个公平的测试。 - Harlan

2

inline包由R驱动，因此获得标准gcc/g++选项。所以我称它为公平的测试 :) 因为它向您展示了编译器如果将R三行代码翻译成C++三行代码，可以为您做什么。无论如何，如果您真的想要，您可以研究汇编代码。 - Dirk Eddelbuettel

嘿，这些说的都是事实。但是它并没有说明R解释器在哪里存在低效率问题。对于我们这些认为从R调用C表明了R本质上是一种有缺陷的语言（或者至少是S的一个有根本性缺陷的实现）的人来说，这更具相关性。 - Harlan

8

恕我直言，那是无稽之谈。任何一个系统都会有其特定的弱点。我的观点是，我们可以通过结合相关的优势来构建更好的系统——正如这个例子所展示的那样——而不是因为系统的弱点而变得紧张。例如，可以看看 Chambers 在去年秋季在 Stanford 的演讲：它始终是关于语言和工具的组合。我要谦虚地指出，Rcpp 可以帮助您结合 C++ 和 R 的优点。但当然，您可以自由选择扔掉 R，使用本周流行的任何东西。祝你好运。 - Dirk Eddelbuettel

15

你使用了指数级别算法！因此对于斐波那契数列第N项，该函数需要调用2的N次方次，而2的35次方是一个非常大的数字....:-)

改用线性算法：

fib = function (x)
{
        if (x == 0)
                return (0)
        n1 = 0
        n2 = 1
        for (i in 1:(x-1)) {
                sum = n1 + n2
                n1 = n2
                n2 = sum
        }
        n2
}

抱歉，编辑：指数递归算法的复杂度不是O(2^N)，而是O(fib(N))，正如Martinho Fernandes大师开玩笑说的那样 :-) 这真是一个很好的注释 :-)

- Tomas

15

因为你正在使用世界上最差的算法之一！

其复杂度为O(fibonacci(n)) = O((黄金比例)^n)，其中黄金比例为1.6180339887498948482…

- Pratik Deoghare

6

因为已经在这里提到了memoise包，所以这里提供一个参考实现：

fib <- function(n) {
  if (n < 2) return(1)
  fib(n - 2) + fib(n - 1)
}
system.time(fib(35))
##    user  system elapsed 
##   36.10    0.02   36.16

library(memoise)
fib2 <- memoise(function(n) {
  if (n < 2) return(1)
  fib2(n - 2) + fib2(n - 1)
})
system.time(fib2(35))
##    user  system elapsed 
##       0       0       0

一般来说，在计算机科学中，记忆化意味着保存函数的结果，以便当您再次使用相同的参数调用它时，它会返回保存的值。来源：Wickham, H.: Advanced R, p. 238.

- vonjd

一般而言，如果您能在其中加入一两句话来解释一下“memoise”包的作用，那将非常有用。 - PatrickT

5

一种具有线性成本的递归实现方法：

fib3 <- function(n){
  fib <- function(n, fibm1, fibm2){
    if(n==1){return(fibm2)}
    if(n==2){return(fibm1)}
    if(n >2){
      fib(n-1, fibm1+fibm2, fibm1)  
    }
  }
fib(n, 1, 0)  
}

与指数级耗时的递归方法相比较：

> system.time(fibonacci(35))
  usuário   sistema decorrido 
   14.629     0.017    14.644 
> system.time(fib3(35))
  usuário   sistema decorrido 
    0.001     0.000     0.000

这个解决方案可以用 ifelse 进行向量化处理：

fib4 <- function(n){
    fib <- function(n, fibm1, fibm2){
        ifelse(n<=1, fibm2,
          ifelse(n==2, fibm1,
            Recall(n-1, fibm1+fibm2, fibm1)  
          ))
    }
    fib(n, 1, 0)  
}

fib4(1:30)
##  [1]      0      1      1      2      3      5      8
##  [8]     13     21     34     55     89    144    233
## [15]    377    610    987   1597   2584   4181   6765
## [22]  10946  17711  28657  46368  75025 121393 196418
## [29] 317811 514229

唯一需要的更改是将 == 更改为 <= ，以适用于n == 1的情况，并将每个if块更改为相应的ifelse。

- Carlos Cinelli

@MatthewLundberg 没有问题！请随意去做。 - Carlos Cinelli

1

我还将初始条件更改为 n，1，0 以使其在数学上正确，但这并不会改变原始代码的运行时间或含义。 - Matthew Lundberg

1

@MatthewLundberg 很好，我也喜欢“回忆录”版。 - Carlos Cinelli

2

如果您真正想返回斐波那契数列，而不是使用此示例探索递归的工作原理，那么可以通过以下非递归方式解决：

fib = function(n) {round((1.61803398875^n+0.61803398875^n)/sqrt(5))}

- Michael Bean

1

该函数的精度可达到 n=55。 - Ferdinand.kraft

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Matthew Plourde · Accepted Answer

Patrick Burns在R地狱中举了一个例子，展示了使用local()和<<-在R中进行记忆化的一种方式。实际上，这是一个斐波那契数列：

fibonacci <- local({
    memo <- c(1, 1, rep(NA, 100))
    f <- function(x) {
        if(x == 0) return(0)
        if(x < 0) return(NA)
        if(x > length(memo))
        stop("’x’ too big for implementation")
        if(!is.na(memo[x])) return(memo[x])
        ans <- f(x-2) + f(x-1)
        memo[x] <<- ans
        ans
    }
})