[Rcpp-commits] r359 - in pkg/inst/examples: . ConvolveBenchmarks

[noreply at r-forge.r-project.org]

Author: edd
Date: 2010-01-12 20:43:13 +0100 (Tue, 12 Jan 2010)
New Revision: 359

Added:
   pkg/inst/examples/ConvolveBenchmarks/
   pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh
   pkg/inst/examples/ConvolveBenchmarks/convolve2.R
   pkg/inst/examples/ConvolveBenchmarks/convolve2_c.c
   pkg/inst/examples/ConvolveBenchmarks/convolve2_cpp.cpp
   pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r
Log:
add beginnings of convolve2 benchmarks


Added: pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh	2010-01-12 19:43:13 UTC (rev 359)
@@ -0,0 +1,13 @@
+#!/bin/bash
+
+# build the shared library for the C variant
+R CMD SHLIB convolve2_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
+
+# call R so that we get an interactive session
+Rscript exampleRCode.r 
\ No newline at end of file


Property changes on: pkg/inst/examples/ConvolveBenchmarks/buildAndRun.sh
___________________________________________________________________
Name: svn:executable
   + *

Added: pkg/inst/examples/ConvolveBenchmarks/convolve2.R
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/convolve2.R	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/convolve2.R	2010-01-12 19:43:13 UTC (rev 359)
@@ -0,0 +1,6 @@
+#!/usr/bin/r -t
+
+## Section 5.10.1 of 'Writing R Extensions' has a simple .Call example
+## for convolution which we are rewriting here
+
+

Added: pkg/inst/examples/ConvolveBenchmarks/convolve2_c.c
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/convolve2_c.c	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/convolve2_c.c	2010-01-12 19:43:13 UTC (rev 359)
@@ -0,0 +1,24 @@
+
+/* This is from 'Writing R Extensions' section 5.10.1 */
+
+#include <R.h>
+#include <Rdefines.h>
+
+SEXP convolve2(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));
+    xa = NUMERIC_POINTER(a); xb = NUMERIC_POINTER(b);
+    xab = NUMERIC_POINTER(ab);
+    for(i = 0; i < nab; i++) xab[i] = 0.0;
+    for(i = 0; i < na; i++)
+	for(j = 0; j < nb; j++) xab[i + j] += xa[i] * xb[j];
+    UNPROTECT(3);
+    return(ab);
+}

Added: pkg/inst/examples/ConvolveBenchmarks/convolve2_cpp.cpp
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/convolve2_cpp.cpp	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/convolve2_cpp.cpp	2010-01-12 19:43:13 UTC (rev 359)
@@ -0,0 +1,24 @@
+// -*- 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 convolve2cpp(SEXP a, SEXP b)
+{
+    RcppVector<double> xa(a);
+    RcppVector<double> xb(b);
+
+    int nab = xa.size() + xb.size() - 1;
+
+    RcppVector<double> xab(nab);
+    for (int i = 0; i < nab; i++) xab(i) = 0.0;
+
+    for (int i = 0; i < xa.size(); i++)
+	for (int j = 0; j < xb.size(); j++) 
+	    xab(i + j) += xa(i) * xb(j);
+
+    RcppResultSet rs;
+    rs.add("ab", xab);
+    return rs.getReturnList();
+}

Added: pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r
===================================================================
--- pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r	                        (rev 0)
+++ pkg/inst/examples/ConvolveBenchmarks/exampleRCode.r	2010-01-12 19:43:13 UTC (rev 359)
@@ -0,0 +1,33 @@
+#!/usr/bin/r
+
+set.seed(42)
+a <- rnorm(100)
+b <- rnorm(100)
+
+## load shared library with wrapper code and callback class
+dyn.load("convolve2_c.so")
+
+## call the wrapper function provided in the shared library
+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")
+
+## call the wrapper function provided in the shared library
+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))
+
+
+
+
+
+
+
+