Для выполнения следующего требуется около 30 секунд, тогда как я ожидал, что он будет почти мгновенным. Есть ли проблема с моим кодом?
x <- fibonacci(35);
fibonacci <- function(seq) {
if (seq == 1) return(1);
if (seq == 2) return(2);
return (fibonacci(seq - 1) + fibonacci(seq - 2));
}
Патрик Бернс приводит пример в 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
}
})
Это просто предоставило прекрасную возможность подключить Rcpp, который позволяет нам легко добавлять функции C ++ в R.
Итак, после небольшого исправления кода и использования пакетов inline (чтобы легко компилировать, загружать и связывать короткие фрагменты кода как динамически загружаемые функции), а также rbenchmark для измерения времени и сравнения функций, мы получаем потрясающий < / strong> 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>
Поскольку вы используете один из худшие алгоритмы в мире!
Сложность которого O(fibonacci(n)) = O((golden ratio)^n) и golden ratio is 1.6180339887498948482…
:-) потому что вы используете экспоненциальный алгоритм !!! Итак, для числа Фибоначчи 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)), как Мартиньо Фернандес сильно пошутил :-) Действительно хорошее замечание :-)
Поскольку memoise package уже упоминался, вот эталонная реализация:
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
В общем, мемоизация в информатике означает, что вы сохраняете результаты функции, чтобы при повторном вызове функции с теми же аргументами она возвращала сохраненное значение.
memoise, вообще говоря.
- person PatrickT; 10.06.2016
Рекурсивная реализация с линейной стоимостью:
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.
n, 1, 0, чтобы они были математически правильными, но это не меняет время выполнения или смысл исходного кода.
- person Matthew Lundberg; 24.08.2014
Recall
- person Carlos Cinelli; 24.08.2014
Если вы действительно хотите вернуть числа Фибоначчи и не используете этот пример для изучения того, как работает рекурсия, вы можете решить эту проблему нерекурсивно, используя следующее:
fib = function(n) {round((1.61803398875^n+0.61803398875^n)/sqrt(5))}
n=55.
- person Ferdinand.kraft; 17.06.2013
1,2,3,5,8,..., тогда как правильная последовательность -0,1,1,2,3,5,8,...? - person Peter K. schedule 24.07.2011gmpимеет функциюfibnumдля вычисления чисел Фибоначчи с произвольной точностью. Со стандартнымdoublesвы можете получить только доn=55или около того. - person Ferdinand.kraft schedule 17.06.2013