[Rcpp-commits] r2156 - in pkg/Rcpp: inst/examples/ConvolveBenchmarks src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Sep 24 11:14:29 CEST 2010


Author: romain
Date: 2010-09-24 11:14:28 +0200 (Fri, 24 Sep 2010)
New Revision: 2156

Added:
   pkg/Rcpp/src/convolve.cpp
Modified:
   pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r
Log:
trying to add the convolve3cpp inside Rcpp library to see if the overhead is due to linking... apparently not

Modified: pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r
===================================================================
--- pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r	2010-09-24 09:04:42 UTC (rev 2155)
+++ pkg/Rcpp/inst/examples/ConvolveBenchmarks/exampleRCode.r	2010-09-24 09:14:28 UTC (rev 2156)
@@ -1,5 +1,6 @@
 #!/usr/bin/r
 
+require( Rcpp )
 set.seed(42)
 a <- rnorm(100)
 b <- rnorm(100)
@@ -21,6 +22,7 @@
 R_API_optimised <- function(n,a,b) .Call("convolve2__loop", n, a, b)
 Rcpp_Classic <- function(n,a,b) .Call("convolve2cpp__loop", n, a, b)
 Rcpp_New_std <- function(n,a,b) .Call("convolve3cpp__loop", n, a, b)
+Rcpp_New_std_inside <- function(n,a,b) .Call("convolve3cpp__loop", n, a, b, PACKAGE = "Rcpp" )
 Rcpp_New_ptr <- function(n,a,b) .Call("convolve4cpp__loop", n, a, b)
 Rcpp_New_sugar <- function(n,a,b) .Call("convolve5cpp__loop", n, a, b)
 R_API_naive <- function(n,a,b) .Call("convolve7__loop", n, a, b)
@@ -48,6 +50,7 @@
                 R_API_naive(REPS,a,b),
                 Rcpp_Classic(REPS,a,b),
                 Rcpp_New_std(REPS,a,b),
+                Rcpp_New_std_inside(REPS,a,b),
                 Rcpp_New_ptr(REPS,a,b),
                 Rcpp_New_sugar(REPS,a,b),
                 Rcpp_New_std_2(REPS,a,b),

Added: pkg/Rcpp/src/convolve.cpp
===================================================================
--- pkg/Rcpp/src/convolve.cpp	                        (rev 0)
+++ pkg/Rcpp/src/convolve.cpp	2010-09-24 09:14:28 UTC (rev 2156)
@@ -0,0 +1,54 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*-
+//
+// convolve.cpp: Rcpp R/C++ interface class library -- coercion
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#include <Rcpp.h>
+
+#define LOOPMACRO_C(name)                   \
+SEXP name##__loop(SEXP n_, SEXP a, SEXP b){ \
+    int n = INTEGER(n_)[0] ;                \
+    SEXP res  = R_NilValue ;                \
+    for( int i=0; i<n; i++){                \
+       res = name( a, b ) ;                 \
+    }                                       \
+    return res ;                            \
+}                                          
+
+#define LOOPMACRO_CPP(name) RcppExport LOOPMACRO_C(name)
+
+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 < n_xa; i++)
+        for (int j = 0; j < n_xb; j++) 
+            xab[i + j] += xa[i] * xb[j];
+
+    return xab ;
+}
+
+LOOPMACRO_CPP(convolve3cpp)
+
+#undef LOOPMACRO_C
+#undef LOOPMACRO_CPP



More information about the Rcpp-commits mailing list