[Rcpp-devel] [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]] ) )
+}
+
+
_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits
More information about the Rcpp-devel
mailing list