[Rcpp-commits] r3175 - in pkg/Rcpp: . inst inst/examples inst/examples/Fibonacci inst/examples/Misc
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 23 21:23:55 CEST 2011
Author: edd
Date: 2011-08-23 21:23:53 +0200 (Tue, 23 Aug 2011)
New Revision: 3175
Added:
pkg/Rcpp/inst/examples/Misc/
pkg/Rcpp/inst/examples/Misc/fibonacci.r
pkg/Rcpp/inst/examples/Misc/ifelseLooped.r
Removed:
pkg/Rcpp/inst/examples/Fibonacci/fib.r
pkg/Rcpp/inst/examples/Misc/fib.r
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/NEWS
Log:
added a new example with a fast loop that isn't easy to vectorise (that was blogged about)
regrouped fibonacci example and this example in a common directory inst/examples/Misc
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2011-08-17 13:37:14 UTC (rev 3174)
+++ pkg/Rcpp/ChangeLog 2011-08-23 19:23:53 UTC (rev 3175)
@@ -1,3 +1,12 @@
+2011-08-23 Dirk Eddelbuettel <edd at debian.org>
+
+ * inst/examples/Misc/ifelseLooped.r: Added new example based on blog
+ post today, and a StackOverflow ansers---and which shows how Rcpp can
+ accelerate loops that may be difficult to vectorise due to dependencies
+
+ * inst/examples/Misc/: New directory for small examples regrouping
+ the new example as well as the fibonacci example added in Rcpp 0.9.6
+
2011-08-17 Dirk Eddelbuettel <edd at debian.org>
* inst/doc/Rcpp-FAQ/Rcpp-FAQ.Rnw: Added a short section including an
Modified: pkg/Rcpp/inst/NEWS
===================================================================
--- pkg/Rcpp/inst/NEWS 2011-08-17 13:37:14 UTC (rev 3174)
+++ pkg/Rcpp/inst/NEWS 2011-08-23 19:23:53 UTC (rev 3175)
@@ -1,5 +1,11 @@
0.9.7 2011-xx-yy
+ o New example 'ifelseLooped.r' showing Rcpp can accelerate loops that may
+ be difficult to vectorise due to dependencies
+
+ o New example directory examples/Misc/ regrouping the new example as
+ well as the fibonacci example added in Rcpp 0.9.6
+
o New Rcpp-FAQ example warning of lossy conversion from 64-bit long
integer types into a 53-bit mantissa which has no clear fix yet.
Deleted: pkg/Rcpp/inst/examples/Fibonacci/fib.r
===================================================================
--- pkg/Rcpp/inst/examples/Fibonacci/fib.r 2011-08-17 13:37:14 UTC (rev 3174)
+++ pkg/Rcpp/inst/examples/Fibonacci/fib.r 2011-08-23 19:23:53 UTC (rev 3175)
@@ -1,55 +0,0 @@
-#!/usr/bin/r
-
-## this short example was provided in response to this StackOverflow questions:
-## http://stackoverflow.com/questions/6807068/why-is-my-recursive-function-so-slow-in-r
-## and illustrates that recursive function calls are a) really expensive in R and b) not
-## all expensive in C++ (my machine sees a 700-fold speed increase) and c) the byte
-## compiler in R does not help here.
-
-## 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(n) {
- if (n == 0) return(0)
- if (n == 1) return(1)
- return (fibR(n - 1) + fibR(n - 2))
-}
-
-## also use byte-compiled R function
-require(compiler)
-fibRC <- cmpfun(fibR)
-
-## load rbenchmark to compare
-library(rbenchmark)
-
-N <- 35 ## same parameter as original post
-res <- benchmark(fibR(N),
- fibRC(N),
- fibRcpp(N),
- columns=c("test", "replications", "elapsed",
- "relative", "user.self", "sys.self"),
- order="relative",
- replications=1)
-print(res) ## show result
-
Deleted: pkg/Rcpp/inst/examples/Misc/fib.r
===================================================================
--- pkg/Rcpp/inst/examples/Fibonacci/fib.r 2011-07-26 22:53:05 UTC (rev 3150)
+++ pkg/Rcpp/inst/examples/Misc/fib.r 2011-08-23 19:23:53 UTC (rev 3175)
@@ -1,54 +0,0 @@
-#!/usr/bin/r
-
-## this short example was provided in response to this StackOverflow questions:
-## http://stackoverflow.com/questions/6807068/why-is-my-recursive-function-so-slow-in-r
-## and illustrates that recursive function calls are a) really expensive in R and b) not
-## all expensive in C++ (my machine sees a 700-fold speed increase) and c) the byte
-## compiler in R does not help here.
-
-## 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));
-}
-
-## also use byte-compiled R function
-fibRC <- cmpfun(fibR)
-
-## load rbenchmark to compare
-library(rbenchmark)
-
-N <- 35 ## same parameter as original post
-res <- benchmark(fibR(N),
- fibRC(N),
- fibRcpp(N),
- columns=c("test", "replications", "elapsed",
- "relative", "user.self", "sys.self"),
- order="relative",
- replications=1)
-print(res) ## show result
-
Copied: pkg/Rcpp/inst/examples/Misc/fibonacci.r (from rev 3150, pkg/Rcpp/inst/examples/Fibonacci/fib.r)
===================================================================
--- pkg/Rcpp/inst/examples/Misc/fibonacci.r (rev 0)
+++ pkg/Rcpp/inst/examples/Misc/fibonacci.r 2011-08-23 19:23:53 UTC (rev 3175)
@@ -0,0 +1,54 @@
+#!/usr/bin/r
+
+## this short example was provided in response to this StackOverflow questions:
+## http://stackoverflow.com/questions/6807068/why-is-my-recursive-function-so-slow-in-r
+## and illustrates that recursive function calls are a) really expensive in R and b) not
+## all expensive in C++ (my machine sees a 700-fold speed increase) and c) the byte
+## compiler in R does not help here.
+
+## 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));
+}
+
+## also use byte-compiled R function
+fibRC <- cmpfun(fibR)
+
+## load rbenchmark to compare
+library(rbenchmark)
+
+N <- 35 ## same parameter as original post
+res <- benchmark(fibR(N),
+ fibRC(N),
+ fibRcpp(N),
+ columns=c("test", "replications", "elapsed",
+ "relative", "user.self", "sys.self"),
+ order="relative",
+ replications=1)
+print(res) ## show result
+
Added: pkg/Rcpp/inst/examples/Misc/ifelseLooped.r
===================================================================
--- pkg/Rcpp/inst/examples/Misc/ifelseLooped.r (rev 0)
+++ pkg/Rcpp/inst/examples/Misc/ifelseLooped.r 2011-08-23 19:23:53 UTC (rev 3175)
@@ -0,0 +1,100 @@
+#!/usr/bin/r
+##
+## This example goes back to the following StackOverflow questions:
+## http://stackoverflow.com/questions/7153586/can-i-vectorize-a-calculation-which-depends-on-previous-elements
+## and provides a nice example of how to accelerate path-dependent
+## loops which are harder to vectorise. It lead to the following blog
+## post:
+## http://dirk.eddelbuettel.com/blog/2011/08/23#rcpp_for_path_dependent_loops
+##
+## Thanks to Josh Ulrich for provided a first nice (R-based) answer on
+## StackOverflow and for also catching a small oversight in my posted answer.
+##
+## Dirk Eddelbuettel, 23 Aug 2011
+##
+## Copyrighted but of course GPL'ed
+
+
+library(inline)
+library(rbenchmark)
+library(compiler)
+
+fun1 <- function(z) {
+ for(i in 2:NROW(z)) {
+ z[i] <- ifelse(z[i-1]==1, 1, 0)
+ }
+ z
+}
+fun1c <- cmpfun(fun1)
+
+
+fun2 <- function(z) {
+ for(i in 2:NROW(z)) {
+ z[i] <- if(z[i-1]==1) 1 else 0
+ }
+ z
+}
+fun2c <- cmpfun(fun2)
+
+
+funRcpp <- cxxfunction(signature(zs="numeric"), plugin="Rcpp", body="
+ Rcpp::NumericVector z = Rcpp::NumericVector(zs);
+ int n = z.size();
+ for (int i=1; i<n; i++) {
+ z[i] = (z[i-1]==1.0 ? 1.0 : 0.0);
+ }
+ return(z);
+")
+
+
+z <- rep(c(1,1,0,0,0,0), 100)
+identical(fun1(z),fun2(z),fun1c(z),fun2c(z),funRcpp(z))
+
+res <- benchmark(fun1(z), fun2(z),
+ fun1c(z), fun2c(z),
+ funRcpp(z),
+ columns=c("test", "replications", "elapsed", "relative", "user.self", "sys.self"),
+ order="relative",
+ replications=1000)
+print(res)
+
+z <- c(1,1,0,0,0,0)
+res2 <- benchmark(fun1(z), fun2(z),
+ fun1c(z), fun2c(z),
+ funRcpp(z),
+ columns=c("test", "replications", "elapsed", "relative", "user.self", "sys.self"),
+ order="relative",
+ replications=10000)
+print(res2)
+
+
+if (FALSE) { # quick test to see if Int vectors are faster: appears not
+ funRcppI <- cxxfunction(signature(zs="integer"), plugin="Rcpp", body="
+ Rcpp::IntegerVector z = Rcpp::IntegerVector(zs);
+ int n = z.size();
+ for (int i=1; i<n; i++) {
+ z[i] = (z[i-1]==1.0 ? 1.0 : 0.0);
+ }
+ return(z);
+ ")
+
+ z <- rep(c(1L,1L,0L,0L,0L,0L), 100)
+ identical(fun1(z),fun2(z),fun1c(z),fun2c(z),funRcppI(z))
+
+ res3 <- benchmark(fun1(z), fun2(z),
+ fun1c(z), fun2c(z),
+ funRcppI(z),
+ columns=c("test", "replications", "elapsed", "relative", "user.self", "sys.self"),
+ order="relative",
+ replications=1000)
+ print(res3)
+
+ z <- c(1L,1L,0L,0L,0L,0L)
+ res4 <- benchmark(fun1(z), fun2(z),
+ fun1c(z), fun2c(z),
+ funRcppI(z),
+ columns=c("test", "replications", "elapsed", "relative", "user.self", "sys.self"),
+ order="relative",
+ replications=10000)
+ print(res4)
+}
More information about the Rcpp-commits
mailing list