[Rcpp-commits] r834 - in pkg/RcppExamples: . R inst src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Mar 4 16:54:06 CET 2010


Author: edd
Date: 2010-03-04 16:54:06 +0100 (Thu, 04 Mar 2010)
New Revision: 834

Added:
   pkg/RcppExamples/R/RcppMatrixExample.R
   pkg/RcppExamples/src/RcppMatrixExample.cpp
Modified:
   pkg/RcppExamples/NAMESPACE
   pkg/RcppExamples/R/RcppVectorExample.R
   pkg/RcppExamples/inst/ChangeLog
   pkg/RcppExamples/src/RcppVectorExample.cpp
Log:
new example RcppMatrixExample for classic and new


Modified: pkg/RcppExamples/NAMESPACE
===================================================================
--- pkg/RcppExamples/NAMESPACE	2010-03-04 04:15:34 UTC (rev 833)
+++ pkg/RcppExamples/NAMESPACE	2010-03-04 15:54:06 UTC (rev 834)
@@ -4,7 +4,8 @@
        print.RcppExample,
        RcppDateExample,
        RcppParamsExample,
-       RcppVectorExample 
+       RcppVectorExample,
+       RcppMatrixExample
 )
 
 #importFrom( utils, capture.output )

Added: pkg/RcppExamples/R/RcppMatrixExample.R
===================================================================
--- pkg/RcppExamples/R/RcppMatrixExample.R	                        (rev 0)
+++ pkg/RcppExamples/R/RcppMatrixExample.R	2010-03-04 15:54:06 UTC (rev 834)
@@ -0,0 +1,34 @@
+
+## RcppMatrixExample.R: Rcpp R/C++ interface class library RcppMatrix example
+##
+## Copyright (C) 2008        Dirk Eddelbuettel
+## Copyright (C) 2009 - 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/>.
+
+RcppMatrixExample <- function(mat=matrix(seq(1,9)^2, ncol=3),
+                              api=c("classic", "new")) {
+
+    api <- match.arg(api)               # match to classic or new
+    fun <- paste(api, "RcppMatrixExample", sep="")
+
+    ## Make the call...
+    val <- .Call(fun,                   # either new or classic
+                 mat,
+                 PACKAGE="RcppExamples")
+
+    val
+}

Modified: pkg/RcppExamples/R/RcppVectorExample.R
===================================================================
--- pkg/RcppExamples/R/RcppVectorExample.R	2010-03-04 04:15:34 UTC (rev 833)
+++ pkg/RcppExamples/R/RcppVectorExample.R	2010-03-04 15:54:06 UTC (rev 834)
@@ -19,20 +19,14 @@
 ## You should have received a copy of the GNU General Public License
 ## along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
-RcppVectorExample <- function(v, api=c("classic", "new")) {
+RcppVectorExample <- function(vec=seq(1,9)^2, api=c("classic", "new")) {
 
-    api <- match.arg(api)
+    api <- match.arg(api)               # match to classic or new
     fun <- paste(api, "RcppVectorExample", sep="")
 
-    ## Check that params is properly set.
-    if (missing(v)) {
-        cat("\nIn R, setting default argument for v\n")
-        v <- seq(1,9)^2
-    }
-
     ## Make the call...
-    val <- .Call(fun,
-                 v,
+    val <- .Call(fun,                   # either new or classic
+                 vec,
                  PACKAGE="RcppExamples")
 
     val

Modified: pkg/RcppExamples/inst/ChangeLog
===================================================================
--- pkg/RcppExamples/inst/ChangeLog	2010-03-04 04:15:34 UTC (rev 833)
+++ pkg/RcppExamples/inst/ChangeLog	2010-03-04 15:54:06 UTC (rev 834)
@@ -1,3 +1,13 @@
+2010-03-04  Dirk Eddelbuettel  <edd at dexter>
+
+	* src/RcppMatrixExample.cpp: Added 'classic' + 'new' API examples
+	* R/RcppVectorExample.R: idem
+
+2010-03-03  Dirk Eddelbuettel  <edd at dexter>
+
+	* src/RcppVectorExample.cpp: Added 'new' API example
+	* R/RcppVectorExample.R: Added argument 'api'
+
 2010-02-27  Dirk Eddelbuettel  <edd at debian.org>
 
 	* src/RcppDateExample.cpp: Carved out of RcppExample.cpp

Added: pkg/RcppExamples/src/RcppMatrixExample.cpp
===================================================================
--- pkg/RcppExamples/src/RcppMatrixExample.cpp	                        (rev 0)
+++ pkg/RcppExamples/src/RcppMatrixExample.cpp	2010-03-04 15:54:06 UTC (rev 834)
@@ -0,0 +1,83 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RcppMatrixExample.cpp: Rcpp R/C++ interface class library RcppMatrix example
+//
+// Copyright (C) 2005 - 2006 Dominick Samperi
+// Copyright (C) 2008        Dirk Eddelbuettel
+// Copyright (C) 2009 - 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>
+
+RcppExport SEXP newRcppMatrixExample(SEXP matrix) {
+
+    Rcpp::NumericMatrix mat(matrix);	// creates Rcpp matrix from SEXP
+    Rcpp::NumericMatrix orig(matrix);	// keep a copy 
+
+    // we could query size via
+    //   int n = mat.nrow(), k=mat.ncol();
+    // and loop over the elements, but using the STL is so much nicer
+    // so we use a STL transform() algorithm on each element
+    std::transform(orig.begin(), orig.end(), mat.begin(), sqrt);
+
+    Rcpp::Pairlist res(Rcpp::Named( "result", mat),
+                       Rcpp::Named( "original", orig));
+
+    return res;
+}
+
+RcppExport SEXP classicRcppMatrixExample(SEXP matrix) {
+
+    SEXP rl = R_NilValue; 		// Use this when there is nothing to be returned.
+    char *exceptionMesg = NULL;
+
+    try {
+
+	// Get parameters in params.
+	RcppMatrix<int> orig(matrix);
+	int n = orig.rows(), k = orig.cols();
+	
+	RcppMatrix<double> mat(n, k); 	// reserve n by k matrix
+ 
+	for (int i=0; i<n; i++) {
+	    for (int j=0; j<k; j++) {
+		mat(i,j) = sqrt(orig(i,j));
+	    }
+	}
+
+	// Build result set to be returned as a list to R.
+	RcppResultSet rs;
+
+	rs.add("result",  mat);
+	rs.add("original", orig);
+
+	// Get the list to be returned to R.
+	rl = rs.getReturnList();
+	
+    } catch(std::exception& ex) {
+	exceptionMesg = copyMessageToR(ex.what());
+    } catch(...) {
+	exceptionMesg = copyMessageToR("unknown reason");
+    }
+    
+    if(exceptionMesg != NULL)
+	Rf_error(exceptionMesg);
+
+    return rl;
+}
+
+

Modified: pkg/RcppExamples/src/RcppVectorExample.cpp
===================================================================
--- pkg/RcppExamples/src/RcppVectorExample.cpp	2010-03-04 04:15:34 UTC (rev 833)
+++ pkg/RcppExamples/src/RcppVectorExample.cpp	2010-03-04 15:54:06 UTC (rev 834)
@@ -1,6 +1,6 @@
 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
 //
-// RcppParamsExample.h: Rcpp R/C++ interface class library RcppVector example
+// RcppVectorExample.cpp: Rcpp R/C++ interface class library RcppVector example
 //
 // Copyright (C) 2005 - 2006 Dominick Samperi
 // Copyright (C) 2008        Dirk Eddelbuettel



More information about the Rcpp-commits mailing list