Почему моя рекурсивная функция так медленно работает в R?

Question

Следующее выполнение занимает около 30 секунд, тогда как я ожидаю, что оно будет почти мгновеннымЕсть ли проблема с моим кодом?

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

Патрик Бернс в примере R Inferno приводит пример одного способа сделать памятку в R с local() и <<-. На самом деле это фибоначчи:

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 2

Это просто предоставило хорошую возможность подключить 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> 

Answer 3

:-) потому что вы используете экспоненциальный алгоритм !!! Таким образом, для числа Фибоначчи 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)), как Мартиньо Фернандес очень пошутил : - ) Действительно хорошая заметка: -)

Answer 4

Поскольку вы используете один из худших алгоритмов в мире !

Сложность которых составляет O(fibonacci(n)) = O((golden ratio)^n) и golden ratio is 1.6180339887498948482…

Answer 5

Поскольку пакет 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.

В общем, в компьютерных науках запоминание означает, что вы сохраняете результаты функции, чтобы при повторном ее вызове с теми же аргументами возвращалось сохраненное значение.

Answer 6

Рекурсивная реализация с линейной стоимостью:

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.

Answer 7

Если вы действительно хотите вернуть числа Фибоначчи и не используете этот пример, чтобы изучить, как работает рекурсия, то вы можете решить ее не рекурсивно, используя следующее:

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