algorithm - ¿Por qué mi función recursiva es tan lenta en R?

optimization recursion

Question

Lo siguiente tarda unos 30 segundos en ejecutarse, mientras que yo esperaría que fuera casi instantáneo. ¿Hay algún problema con mi código?

x <- fibonacci(35);

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

Answer 1

¡Porque estás usando uno de los peores algoritmos del mundo !

La complejidad de los cuales es O(fibonacci(n)) = O((golden ratio)^n) y golden ratio is 1.6180339887498948482…

Answer 2

:-) porque usas algoritmo exponencial !!! Así que para el número N de fibonacci tiene que llamar a la función 2 ^ N veces, lo que es 2 ^ 35, que es un número ... :-)

Utilizar algoritmo lineal:

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
}

Disculpe, edite: la complejidad del algoritmo recursivo exponencial no es O (2 ^ N) sino O (fib (N)), como Martinho Fernandes bromeó :-) Realmente una buena nota :-)

Answer 3

Debido a que el paquete memoise ya se mencionó aquí es una implementación de referencia:

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

Fuente: Wickham, H .: Advanced R, p. 238.

En general, la memorización en ciencias informáticas significa que usted guarda los resultados de una función para que cuando la vuelva a llamar con los mismos argumentos devuelva el valor guardado.

Answer 4

Eso solo brindó una buena oportunidad para conectar Rcpp que nos permite agregar funciones de C ++ fácilmente a R.

Entonces, después de corregir un poco su código y usar los paquetes en inline (para compilar, cargar y vincular fácilmente fragmentos de código cortos como funciones que se pueden cargar dinámicamente), así como rbenchmark para rbenchmark y comparar funciones, terminamos con un impresionante aumento de 700 veces :

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> 

Aquí vemos los tiempos transcurridos de 92 milésimas frente a 65 segundos, para una relación relativa de 714. Pero a estas alturas, todos los demás le dijeron que no hiciera esto directamente en R ... El código está abajo.

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

Y para completar, las funciones también producen el resultado correcto:

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> 

Answer 5

Patrick Burns da un ejemplo en R Inferno de una manera de hacer una memoización en R con local() y <<- . De hecho, es un 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
    }
})

Answer 6

Si realmente está buscando devolver números de Fibonacci y no está usando este ejemplo para explorar cómo funciona la recursión, puede resolverlo de manera no recursiva utilizando lo siguiente:

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

Answer 7

Una implementación recursiva con coste lineal:

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

Comparando con la solución recursiva con costo exponencial:

> 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

Esta solución puede vectorizarse con 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

Los únicos cambios requeridos están cambiando == a <= para el caso n==1 , y cambiando cada bloque if al ifelse equivalente.