Why is my recursive function so slow in R? Why is my recursive function so slow in R? r r

Why is my recursive function so slow in R?


Patrick Burns gives an example in R Inferno of one way to do memoization in R with local() and <<-. In fact, it's a fibonacci:

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


That just provided a nice opportunity to plug Rcpp which allows us to add C++ functions easily to R.

So after fixing your code slightly, and using the packages inline (to easily compile, load and link short code snippets as dynamically loadable functions) as well as rbenchmark to time and compare functions, we end up with a stunning 700-fold increase in performance:

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

Here we see elapsed times of 92 milliseonds versus 65 seconds, for a relative ratio of 714. But by now everybody else told you not to do this directly in R.... The code is below.

## inline to compile, load and link the C++ coderequire(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 callsincltxt <- '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 comparelibrary(rbenchmark)N <- 35     ## same parameter as original postres <- benchmark(fibR(N),                 fibRcpp(N),                 columns=c("test", "replications", "elapsed",                           "relative", "user.self", "sys.self"),                 order="relative",                 replications=1)print(res)  ## show result

And for completeness, the functions also produce the correct output:

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


Because you are using one of the worst algorithms in the world!

Complexity of which is O(fibonacci(n)) = O((golden ratio)^n) and golden ratio is 1.6180339887498948482…