Pourquoi ma fonction récursive est si lente en R?

Que simplement fourni une belle occasion de se brancher Rcpp ce qui nous permet d'ajouter des fonctions C++ facilement à R.

donc après avoir légèrement corrigé votre code, et en utilisant les paquets inline (pour compiler, charger et relier facilement les courts extraits de code en tant que fonctions chargeables dynamiquement) ainsi que rbenchmark temps et des fonctions de comparaison, nous nous retrouvons avec un superbe augmentation de 700 fois dans la performance:

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> 

ici nous voir temps écoulé de 92 millisecondes par rapport à 65 secondes, pour un rapport relatif de 714. Mais maintenant tout le monde t'a dit de ne pas faire ça directement en R.... Le code est ci-dessous.

## 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

Et pour être complet, les fonctions aussi produire le bon de sortie:

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> 

parce que vous utilisez un des le pire des algorithmes dans le monde!

dont la complexité est O(fibonacci(n))= O((golden ratio)^n) et golden ratio is 1.6180339887498948482…

:-) parce que vous utilisez l'algorithme exponentiel!!! Donc, pour fibonacci numéro N il doit appeler la fonction 2^N fois, qui 2^35, qui est diable d'un nombre.... : -)

utiliser l'algorithme linéaire:

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
}

Désolé, edit: la complexité de l'algorithme récursif n'est pas O(2^N), mais O(fib(N)), Martinho Fernandes grandement plaisanté :-) Vraiment une bonne note :-)

parce que le memoise paquet a déjà été mentionné voici une implémentation de référence:

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

Source: Wickham, H.: Advanced R, p. 538.

En général memoization en informatique signifie que vous enregistrez les résultats d'une fonction de sorte que lorsque vous l'appelez de nouveau avec les mêmes arguments, il renvoie la valeur enregistrée.

récursive de la mise en œuvre linéaires coût:

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

en Comparant avec la solution récursive avec un coût exponentiel:

> 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

Cette solution peut être vectorisée avec 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

les seuls changements nécessaires sont ==<= pour les n==1 cas, et changent à chaque if bloc à l'équivalent ifelse.

si vous cherchez vraiment à retourner les nombres Fibonacci et que vous n'utilisez pas cet exemple pour explorer comment fonctionne la récursion, alors vous pouvez le résoudre de façon non-récursive en utilisant ce qui suit:

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