[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