[Rcpp-commits] r608 - pkg/inst/examples/functionCallback

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Feb 6 19:04:20 CET 2010


Author: edd
Date: 2010-02-06 19:04:20 +0100 (Sat, 06 Feb 2010)
New Revision: 608

Modified:
   pkg/inst/examples/functionCallback/README
   pkg/inst/examples/functionCallback/RcppFunctionCallExample.cpp
Log:
updated


Modified: pkg/inst/examples/functionCallback/README
===================================================================
--- pkg/inst/examples/functionCallback/README	2010-02-06 17:54:14 UTC (rev 607)
+++ pkg/inst/examples/functionCallback/README	2010-02-06 18:04:20 UTC (rev 608)
@@ -1,4 +1,11 @@
 
+A much simpler version of the example is provided in the file newApiExample.r.
+With littler installed, it can be run 'as is' as a shell script; else it can
+be sourced into R.
+
+ -- Dirk Eddelbuettel and Romain Francois,  06 Feb 2010
+
+
 This directory provides a simple example of how an R function 
 can be passed back and forth between R and C++.  
 

Modified: pkg/inst/examples/functionCallback/RcppFunctionCallExample.cpp
===================================================================
--- pkg/inst/examples/functionCallback/RcppFunctionCallExample.cpp	2010-02-06 17:54:14 UTC (rev 607)
+++ pkg/inst/examples/functionCallback/RcppFunctionCallExample.cpp	2010-02-06 18:04:20 UTC (rev 608)
@@ -1,11 +1,35 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Rcpp.h: R/C++ interface class library
+//
+// 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"
 
-// Define a (file-local) class that can be used to call an R function that expects a
-// real vector argument and returns a vector.  
+// This file shows how to use an R function in a callback from C++. It
+// is implemented using the 'classic Rcpp' API. A simpler alternative
+// using the 'new Rcpp' API is provided in the file 'newApiExample.r'/
+
+// Define a (file-local) class that can be used to call an R function
+// that expects a real vector argument and returns a vector.
 // 
-// We define this class by inhereting from Rcpp's RcppFunction class and adding a 
-// single function 'transformVector'
+// We define this class by inhereting from Rcpp's RcppFunction class
+// and adding a single function 'transformVector'
 //
 // The R function being used is defined in the R script calling this
 //
@@ -13,22 +37,21 @@
 public:
     RVectorFuncCall(SEXP fn) : RcppFunction(fn) {}
 
-    // This function will use an R function to operate on all elements of vector v
-	std::vector<double> transformVector(std::vector<double>& v) {
+    // This function uses an R function to operate on all elements of vector v
+    std::vector<double> transformVector(std::vector<double>& v) {
+	setRVector(v);		// Turn vector into a SEXP to be passed  to R
 
-		setRVector(v);		// Turn vector into a SEXP that can be passed to R as an argument.
+	// Call the R function passed in as the paramter fn, 
+	// with SEXP vector that was just set as its argument.
+	SEXP result = vectorCall();
 
-		// Call the R function passed in as the paramter fn, 
-		// with SEXP vector that was just set as its argument.
-		SEXP result = vectorCall();
+	// Turn returned R vector into a C++ vector, clear protection stack, and return.
+	std::vector<double> vec( RcppVector<double>(result).stlVector() );
 
-		// Turn returned R vector into a C++ vector, clear protection stack, and return.
-		std::vector<double> vec( RcppVector<double>(result).stlVector() );
-
-		// Safe now to clear the contribution of this function to the protection stack.
-		clearProtectionStack();
+	// Safe now to clear the contribution of this function to the protection stack.
+	clearProtectionStack();
 		
-		return vec;
+	return vec;
     }
 };
 
@@ -36,39 +59,38 @@
 // Standard wrapper C++ function using Rcpp interface, this function will be called from R
 RcppExport SEXP RCppFunctionCallWrapper(SEXP params, SEXP numvec, SEXP fnvec) {
 
-	SEXP  rl = R_NilValue; 				// Use this when there is nothing to be returned.
-	char* exceptionMesg=NULL;
+    SEXP  rl = R_NilValue;		// Use this when there is nothing to be returned.
+    char* exceptionMesg = NULL;
 
-	try {
+    try {
+	RcppParams rparam(params);	// Get parameters in params.
+	int N = rparam.getIntValue("N");
 
-		RcppParams rparam(params);		// Get parameters in params.
-		int N = rparam.getIntValue("N");
+	std::vector<double> vec( RcppVector<double>(numvec).stlVector());
 
-		std::vector<double> vec( RcppVector<double>(numvec).stlVector());
+	for (int i=0; i<N; i++) { 
 
-		for (int i=0; i<N; i++) { 
+	    // Test RVectorFuncCall defined above, init'ed with the supplied function
+	    RVectorFuncCall vfunc(fnvec);
 
-			// Test RVectorFuncCall defined above, init'ed with the supplied function
-			RVectorFuncCall vfunc(fnvec);
-
-			// transform vec with the R function given to vfunc
-			vec = vfunc.transformVector(vec);
+	    // transform vec with the R function given to vfunc
+	    vec = vfunc.transformVector(vec);
 			
-		}
-		// Build result set to be returned as a list to R.
-		RcppResultSet rs;
-		rs.add("vec", vec);
+	}
+	// Build result set to be returned as a list to R.
+	RcppResultSet rs;
+	rs.add("vec", vec);
+	
+	rl = rs.getReturnList();		// Get the list to be returned to R.
 
-		rl = rs.getReturnList();		// Get the list to be returned to R.
-
-	} catch(std::exception& ex) {
-		exceptionMesg = copyMessageToR(ex.what());
-	} catch(...) {
-		exceptionMesg = copyMessageToR("unknown reason");
-	}
+    } catch(std::exception& ex) {
+	exceptionMesg = copyMessageToR(ex.what());
+    } catch(...) {
+	exceptionMesg = copyMessageToR("unknown reason");
+    }
     
-	if(exceptionMesg != NULL)
-		Rf_error(exceptionMesg);
+    if(exceptionMesg != NULL)
+	Rf_error(exceptionMesg);
   
-	return rl;
+    return rl;
 }



More information about the Rcpp-commits mailing list