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.