[Rcpp-commits] r360 - pkg/inst/examples/ConvolveBenchmarks

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jan 12 21:37:39 CET 2010


Author: romain
Date: 2010-01-12 21:37:38 +0100 (Tue, 12 Jan 2010)
New Revision: 360

Added:
   pkg/inst/examples/ConvolveBenchmarks/convolve3_cpp.cpp
   pkg/inst/examples/ConvolveBenchmarks/convolve4_cpp.cpp
   pkg/inst/examples/ConvolveBenchmarks/convolve7_c.c
Modified:
   pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh
   pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r
Log:
added versions based on NumericVector

Modified: pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh	2010-01-12 19:43:13 UTC (rev 359)
+++ pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh	2010-01-12 20:37:38 UTC (rev 360)
@@ -2,12 +2,15 @@
 
 # build the shared library for the C variant
 R CMD SHLIB convolve2_c.c
+R CMD SHLIB convolve7_c.c
 
 # build the shared library for the C++ variant
 # we have to let R know where the Rcpp header and library are
 export PKG_CPPFLAGS=`r -e "Rcpp:::CxxFlags()"`
 export PKG_LIBS=`r -e "Rcpp:::LdFlags()"`
 R CMD SHLIB convolve2_cpp.cpp
+R CMD SHLIB convolve3_cpp.cpp
+R CMD SHLIB convolve4_cpp.cpp
 
 # call R so that we get an interactive session
-Rscript exampleRCode.r 
\ No newline at end of file
+Rscript exampleRCode.r 

Added: pkg/inst/examples/ConvolveBenchmarks/convolve3_cpp.cpp
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/convolve3_cpp.cpp	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/convolve3_cpp.cpp	2010-01-12 20:37:38 UTC (rev 360)
@@ -0,0 +1,21 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+
+// This is a rewrite of the 'Writing R Extensions' section 5.10.1 example
+
+#include <Rcpp.h>
+
+RcppExport SEXP convolve3cpp(SEXP a, SEXP b){
+    Rcpp::NumericVector xa(a);
+    Rcpp::NumericVector xb(b);
+    int n_xa = xa.size() ;
+    int n_xb = xb.size() ;
+    int nab = n_xa + n_xb - 1;
+    Rcpp::NumericVector xab(nab);
+
+    for (int i = 0; i < nab; i++) xab[i] = 0.0;
+    for (int i = 0; i < n_xa; i++)
+        for (int j = 0; j < n_xb; j++) 
+            xab[i + j] += xa[i] * xb[j];
+
+    return xab ;
+}

Added: pkg/inst/examples/ConvolveBenchmarks/convolve4_cpp.cpp
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/convolve4_cpp.cpp	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/convolve4_cpp.cpp	2010-01-12 20:37:38 UTC (rev 360)
@@ -0,0 +1,25 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+
+// This is a rewrite of the 'Writing R Extensions' section 5.10.1 example
+
+#include <Rcpp.h>
+
+RcppExport SEXP convolve4cpp(SEXP a, SEXP b) {
+    Rcpp::NumericVector xa(a);
+    Rcpp::NumericVector xb(b);
+    int n_xa = xa.size() ;
+    int n_xb = xb.size() ;
+    int nab = n_xa + n_xb - 1;
+    Rcpp::NumericVector xab(nab);
+    
+    double* pa = xa.begin() ;
+    double* pb = xb.begin() ;
+    double* pab = xab.begin() ;
+    int i,j=0; 
+    for (i = 0; i < nab; i++) pab[i] = 0.0;
+    for (i = 0; i < n_xa; i++)
+	for (j = 0; j < n_xb; j++) 
+	    pab[i + j] += pa[i] * pb[j];
+
+    return xab ;
+}

Added: pkg/inst/examples/ConvolveBenchmarks/convolve7_c.c
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/convolve7_c.c	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/convolve7_c.c	2010-01-12 20:37:38 UTC (rev 360)
@@ -0,0 +1,22 @@
+
+/* This is from 'Writing R Extensions' section 5.10.1 */
+
+#include <R.h>
+#include <Rdefines.h>
+
+SEXP convolve7(SEXP a, SEXP b)
+{
+    int i, j, na, nb, nab;
+    double *xa, *xb, *xab;
+    SEXP ab;
+
+    PROTECT(a = AS_NUMERIC(a));
+    PROTECT(b = AS_NUMERIC(b));
+    na = LENGTH(a); nb = LENGTH(b); nab = na + nb - 1;
+    PROTECT(ab = NEW_NUMERIC(nab));
+    for(i = 0; i < nab; i++) REAL(ab)[i] = 0.0;
+    for(i = 0; i < na; i++)
+    	for(j = 0; j < nb; j++) REAL(ab)[i + j] += REAL(a)[i] * REAL(b)[j];
+    UNPROTECT(3);
+    return(ab);
+}

Modified: pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r	2010-01-12 19:43:13 UTC (rev 359)
+++ pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r	2010-01-12 20:37:38 UTC (rev 360)
@@ -11,6 +11,7 @@
 v1 <- .Call("convolve2", a, b)
 t1 <- system.time(replicate(1000, .Call("convolve2", a, b)))
 
+
 ## load shared library with wrapper code and callback class
 dyn.load("convolve2_cpp.so")
 
@@ -18,16 +19,46 @@
 v2 <- .Call("convolve2cpp", a, b)[[1]]
 t2 <- system.time(replicate(1000, .Call("convolve2cpp", a, b)))
 
-print(t1)
-print(t2)
-print(summary(v1))
-print(summary(v2))
-print(all.equal(v1, v2))
 
+## load shared library with wrapper code and callback class
+dyn.load("convolve3_cpp.so")
 
+## call the wrapper function provided in the shared library
+v3 <- .Call("convolve3cpp", a, b)
+t3 <- system.time(replicate(1000, .Call("convolve3cpp", a, b)))
 
 
+## load shared library with wrapper code and callback class
+dyn.load("convolve4_cpp.so")
 
+## call the wrapper function provided in the shared library
+v4 <- .Call("convolve4cpp", a, b)
+t4 <- system.time(replicate(1000, .Call("convolve4cpp", a, b)))
 
 
+## load shared library with wrapper code and callback class
+dyn.load("convolve7_c.so")
 
+## call the wrapper function provided in the shared library
+v7 <- .Call("convolve7", a, b)
+t7 <- system.time(replicate(1000, .Call("convolve7", a, b)))
+
+
+
+cat( "Writing R extensions:\n" )
+print(t1)
+cat( "\nLess careful use of R API\n")
+print(t7)
+cat( "\nRcppVector<double>::operator()\n")
+print(t2)
+cat( "\nRcpp::NumericVector::operator[]\n")
+print(t3)
+cat( "\nRcpp::NumericVector::begin()\n")
+print(t4)
+
+results <- list( v1, v2, v3, v4, v7)
+for( i in seq_along(results) ){
+	stopifnot( identical(results[[1L]], results[[i]] ) )
+}
+
+



More information about the Rcpp-commits mailing list