|
Rcpp Version 0.9.10
|
00001 #!/usr/bin/r 00002 00003 ## this short example was provided in response to this StackOverflow questions: 00004 ## http://stackoverflow.com/questions/6807068/why-is-my-recursive-function-so-slow-in-r 00005 ## and illustrates that recursive function calls are a) really expensive in R and b) not 00006 ## all expensive in C++ (my machine sees a 700-fold speed increase) and c) the byte 00007 ## compiler in R does not help here. 00008 00009 ## inline to compile, load and link the C++ code 00010 require(inline) 00011 00012 ## byte compiler 00013 require(compiler) 00014 00015 ## we need a pure C/C++ function as the generated function 00016 ## will have a random identifier at the C++ level preventing 00017 ## us from direct recursive calls 00018 incltxt <- ' 00019 int fibonacci(const int x) { 00020 if (x == 0) return(0); 00021 if (x == 1) return(1); 00022 return (fibonacci(x - 1)) + fibonacci(x - 2); 00023 }' 00024 00025 ## now use the snipped above as well as one argument conversion 00026 ## in as well as out to provide Fibonacci numbers via C++ 00027 fibRcpp <- cxxfunction(signature(xs="int"), 00028 plugin="Rcpp", 00029 incl=incltxt, 00030 body=' 00031 int x = Rcpp::as<int>(xs); 00032 return Rcpp::wrap( fibonacci(x) ); 00033 ') 00034 00035 ## for comparison, the original (but repaired with 0/1 offsets) 00036 fibR <- function(seq) { 00037 if (seq == 0) return(0); 00038 if (seq == 1) return(1); 00039 return (fibR(seq - 1) + fibR(seq - 2)); 00040 } 00041 00042 ## also use byte-compiled R function 00043 fibRC <- cmpfun(fibR) 00044 00045 ## load rbenchmark to compare 00046 library(rbenchmark) 00047 00048 N <- 35 ## same parameter as original post 00049 res <- benchmark(fibR(N), 00050 fibRC(N), 00051 fibRcpp(N), 00052 columns=c("test", "replications", "elapsed", 00053 "relative", "user.self", "sys.self"), 00054 order="relative", 00055 replications=1) 00056 print(res) ## show result 00057