[Rcpp-commits] r2807 - in pkg/RcppExamples: R src

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

Author: edd
Date: 2010-12-20 20:40:08 +0100 (Mon, 20 Dec 2010)
New Revision: 2807

Modified:
   pkg/RcppExamples/R/RcppDateExample.R
   pkg/RcppExamples/R/RcppParamsExample.R
   pkg/RcppExamples/src/RcppDateExample.cpp
   pkg/RcppExamples/src/RcppParamsExample.cpp
Log:
two new examples for the new API


Modified: pkg/RcppExamples/R/RcppDateExample.R
===================================================================
--- pkg/RcppExamples/R/RcppDateExample.R	2010-12-20 16:19:13 UTC (rev 2806)
+++ pkg/RcppExamples/R/RcppDateExample.R	2010-12-20 19:40:08 UTC (rev 2807)
@@ -19,8 +19,12 @@
 ## You should have received a copy of the GNU General Public License
 ## along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
-RcppDateExample <- function(dv, dtv) {
+RcppDateExample <- function(dv, dtv,
+                            api=c("classic", "new")) {
 
+    api <- match.arg(api)               # match to classic or new
+    fun <- paste(api, "RcppDateExample", sep="")
+
     ## Check that params is properly set.
     if (missing(dv)) {
         cat("\nIn R, setting default argument for dv\n")
@@ -33,7 +37,7 @@
     }
 
     ## Make the call...
-    val <- .Call("RcppDateExample",
+    val <- .Call(fun,                   # either new or classic
                  dv, dtv,
                  PACKAGE="RcppExamples")
 

Modified: pkg/RcppExamples/R/RcppParamsExample.R
===================================================================
--- pkg/RcppExamples/R/RcppParamsExample.R	2010-12-20 16:19:13 UTC (rev 2806)
+++ pkg/RcppExamples/R/RcppParamsExample.R	2010-12-20 19:40:08 UTC (rev 2807)
@@ -19,8 +19,12 @@
 ## You should have received a copy of the GNU General Public License
 ## along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
-RcppParamsExample <- function(params) {
+RcppParamsExample <- function(params,
+                              api=c("classic", "new")) {
 
+    api <- match.arg(api)               # match to classic or new
+    fun <- paste(api, "RcppParamsExample", sep="")
+
     ## Check that params is properly set.
     if (missing(params)) {
         cat("\nIn R, setting default argument for params\n")
@@ -31,7 +35,7 @@
     }
 
     ## Make the call...
-    val <- .Call("RcppParamsExample",
+    val <- .Call(fun,
                  params,
                  PACKAGE="RcppExamples")
 

Modified: pkg/RcppExamples/src/RcppDateExample.cpp
===================================================================
--- pkg/RcppExamples/src/RcppDateExample.cpp	2010-12-20 16:19:13 UTC (rev 2806)
+++ pkg/RcppExamples/src/RcppDateExample.cpp	2010-12-20 19:40:08 UTC (rev 2807)
@@ -23,8 +23,40 @@
 
 #include <RcppClassic.h>
 
-RcppExport SEXP RcppDateExample(SEXP dvsexp, SEXP dtvsexp) {
+RcppExport SEXP newRcppDateExample(SEXP dvsexp, SEXP dtvsexp) {
 
+    try {					// or use BEGIN_RCPP macro
+
+	Rcpp::DateVector dv(dvsexp);
+	Rcpp::DatetimeVector dtv(dtvsexp);
+	Rcpp::Function formatDate("format.Date");
+	Rcpp::Function formatDatetime("format.POSIXct");
+
+	Rprintf("\nIn C++, seeing the following date value\n");
+	for (int i=0; i<dv.size(); i++) {
+	    std::cout << Rcpp::as<std::string>(formatDate(Rcpp::wrap(dv[i]))) << std::endl;
+	    dv[i] = dv[i] + 7;		// shift a week
+	}
+	Rprintf("\nIn C++, seeing the following datetime value\n");
+	for (int i=0; i<dtv.size(); i++) {
+	    std::cout << Rcpp::as<std::string>(formatDatetime(Rcpp::wrap(dtv[i]))) << std::endl;
+	    dtv[i] = dtv[i] + 0.250;    // shift 250 millisec
+	}
+
+	// Build result set to be returned as a list to R.
+	return Rcpp::List::create(Rcpp::Named("date",   dv),
+				  Rcpp::Named("datetime", dtv));
+
+    } catch( std::exception &ex ) {		// or use END_RCPP macro
+	forward_exception_to_r( ex );
+    } catch(...) { 
+	::Rf_error( "c++ exception (unknown reason)" ); 
+    }
+    return R_NilValue; // -Wall
+}
+
+RcppExport SEXP classicRcppDateExample(SEXP dvsexp, SEXP dtvsexp) {
+
     SEXP rl = R_NilValue;		 // Use this when there is nothing to be returned.
     char *exceptionMesg = NULL;
 

Modified: pkg/RcppExamples/src/RcppParamsExample.cpp
===================================================================
--- pkg/RcppExamples/src/RcppParamsExample.cpp	2010-12-20 16:19:13 UTC (rev 2806)
+++ pkg/RcppExamples/src/RcppParamsExample.cpp	2010-12-20 19:40:08 UTC (rev 2807)
@@ -23,8 +23,39 @@
 
 #include <RcppClassic.h>
 
-RcppExport SEXP RcppParamsExample(SEXP params) {
+RcppExport SEXP newRcppParamsExample(SEXP params) {
 
+    try {					// or use BEGIN_RCPP macro
+
+	Rcpp::List rparam(params); 		// Get parameters in params.
+	std::string method   = Rcpp::as<std::string>(rparam["method"]);
+	double tolerance     = Rcpp::as<double>(rparam["tolerance"]);
+	int    maxIter       = Rcpp::as<int>(rparam["maxIter"]);
+	Rcpp::Date startDate = Rcpp::Date(Rcpp::as<int>(rparam["startDate"])); // ctor from int
+	
+	Rprintf("\nIn C++, seeing the following value\n");
+	Rprintf("Method argument    : %s\n", method.c_str());
+	Rprintf("Tolerance argument : %f\n", tolerance);
+	Rprintf("MaxIter argument   : %d\n", maxIter);
+	Rprintf("Start date argument: %04d-%02d-%02d\n", 
+		startDate.getYear(), startDate.getMonth(), startDate.getDay());
+
+	return Rcpp::List::create(Rcpp::Named("method", method),
+				  Rcpp::Named("tolerance", tolerance),
+				  Rcpp::Named("maxIter", maxIter),
+				  Rcpp::Named("startDate", startDate),
+				  Rcpp::Named("params", params));  // or use rparam
+
+    } catch( std::exception &ex ) {		// or use END_RCPP macro
+	forward_exception_to_r( ex );
+    } catch(...) { 
+	::Rf_error( "c++ exception (unknown reason)" ); 
+    }
+    return R_NilValue; // -Wall
+}
+
+RcppExport SEXP classicRcppParamsExample(SEXP params) {
+
     SEXP rl = R_NilValue; 	// Use this when there is nothing to be returned.
     char *exceptionMesg = NULL;