[Rcpp-commits] r833 - in pkg/RcppExamples: R src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Mar 4 05:15:34 CET 2010
Author: edd
Date: 2010-03-04 05:15:34 +0100 (Thu, 04 Mar 2010)
New Revision: 833
Modified:
pkg/RcppExamples/R/RcppDateExample.R
pkg/RcppExamples/R/RcppParamsExample.R
pkg/RcppExamples/R/RcppVectorExample.R
pkg/RcppExamples/src/RcppDateExample.cpp
pkg/RcppExamples/src/RcppParamsExample.cpp
pkg/RcppExamples/src/RcppVectorExample.cpp
Log:
added a 'new API' version in RcppVectorExample.cpp
modified RcppVectorExample.R to be able to call 'classic' and 'new'
added a few missing #include <Rcpp.h> to cpp files
no set class(RcppExample) as that made sense only on the initial RcppExample()
Modified: pkg/RcppExamples/R/RcppDateExample.R
===================================================================
--- pkg/RcppExamples/R/RcppDateExample.R 2010-03-04 03:44:20 UTC (rev 832)
+++ pkg/RcppExamples/R/RcppDateExample.R 2010-03-04 04:15:34 UTC (rev 833)
@@ -37,13 +37,6 @@
dv, dtv,
PACKAGE="RcppExamples")
- ## Define a class for the return value so we can control what gets
- ## printed when a variable assigned this value is typed on a line by itself.
- ## This has the effect of calling the function print.RcppExample(). The
- ## function (defined below) simply prints the names of the fields that are
- ## available. Access each field with val$name.
- class(val) <- "RcppExample"
-
val
}
Modified: pkg/RcppExamples/R/RcppParamsExample.R
===================================================================
--- pkg/RcppExamples/R/RcppParamsExample.R 2010-03-04 03:44:20 UTC (rev 832)
+++ pkg/RcppExamples/R/RcppParamsExample.R 2010-03-04 04:15:34 UTC (rev 833)
@@ -35,13 +35,6 @@
params,
PACKAGE="RcppExamples")
- ## Define a class for the return value so we can control what gets
- ## printed when a variable assigned this value is typed on a line by itself.
- ## This has the effect of calling the function print.RcppExample(). The
- ## function (defined below) simply prints the names of the fields that are
- ## available. Access each field with val$name.
- class(val) <- "RcppExample"
-
val
}
Modified: pkg/RcppExamples/R/RcppVectorExample.R
===================================================================
--- pkg/RcppExamples/R/RcppVectorExample.R 2010-03-04 03:44:20 UTC (rev 832)
+++ pkg/RcppExamples/R/RcppVectorExample.R 2010-03-04 04:15:34 UTC (rev 833)
@@ -19,8 +19,11 @@
## 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) {
+RcppVectorExample <- function(v, api=c("classic", "new")) {
+ api <- match.arg(api)
+ fun <- paste(api, "RcppVectorExample", sep="")
+
## Check that params is properly set.
if (missing(v)) {
cat("\nIn R, setting default argument for v\n")
@@ -28,16 +31,9 @@
}
## Make the call...
- val <- .Call("RcppVectorExample",
+ val <- .Call(fun,
v,
PACKAGE="RcppExamples")
- ## Define a class for the return value so we can control what gets
- ## printed when a variable assigned this value is typed on a line by itself.
- ## This has the effect of calling the function print.RcppExample(). The
- ## function (defined below) simply prints the names of the fields that are
- ## available. Access each field with val$name.
- class(val) <- "RcppExample"
-
val
}
Modified: pkg/RcppExamples/src/RcppDateExample.cpp
===================================================================
--- pkg/RcppExamples/src/RcppDateExample.cpp 2010-03-04 03:44:20 UTC (rev 832)
+++ pkg/RcppExamples/src/RcppDateExample.cpp 2010-03-04 04:15:34 UTC (rev 833)
@@ -21,6 +21,8 @@
// 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 RcppDateExample(SEXP dvsexp, SEXP dtvsexp) {
SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
Modified: pkg/RcppExamples/src/RcppParamsExample.cpp
===================================================================
--- pkg/RcppExamples/src/RcppParamsExample.cpp 2010-03-04 03:44:20 UTC (rev 832)
+++ pkg/RcppExamples/src/RcppParamsExample.cpp 2010-03-04 04:15:34 UTC (rev 833)
@@ -21,6 +21,8 @@
// 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 RcppParamsExample(SEXP params) {
SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
@@ -70,85 +72,4 @@
return rl;
}
-RcppExport SEXP RcppDateExample(SEXP dvsexp, SEXP dtvsexp) {
- SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
- char *exceptionMesg = NULL;
-
- try {
-
- RcppDateVector dv(dvsexp);
- RcppDatetimeVector dtv(dtvsexp);
-
- Rprintf("\nIn C++, seeing the following date value\n");
- for (int i=0; i<dv.size(); i++) {
- std::cout << 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 << dtv(i) << std::endl;
- dtv(i) = dtv(i) + 0.250; // shift 250 millisec
- }
-
- // Build result set to be returned as a list to R.
- RcppResultSet rs;
- rs.add("date", dv);
- rs.add("datetime", dtv);
-
- // 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;
-}
-
-RcppExport SEXP RcppVectorExample(SEXP vector) {
-
- SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
- char *exceptionMesg = NULL;
-
- try {
-
- // Get parameters in params.
- RcppVector<int> vec(vector);
- int n = vec.size();
-
- Rprintf("\nIn C++, seeing a vector of length %d\n", n);
-
- // create a C++ STL vector, and reserve appropriate size
- std::vector<double> res(n);
-
- for (int i=0; i<n; i++) {
- res[i] = sqrt(static_cast<double>(vec(i)));
- }
-
- // Build result set to be returned as a list to R.
- RcppResultSet rs;
-
- rs.add("result", res);
- rs.add("original", vec);
-
- // 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 03:44:20 UTC (rev 832)
+++ pkg/RcppExamples/src/RcppVectorExample.cpp 2010-03-04 04:15:34 UTC (rev 833)
@@ -21,8 +21,27 @@
// You should have received a copy of the GNU General Public License
// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
-RcppExport SEXP RcppVectorExample(SEXP vector) {
+#include <Rcpp.h>
+RcppExport SEXP newRcppVectorExample(SEXP vector) {
+
+ Rcpp::NumericVector vec(vector); // creates Rcpp vector from SEXP
+ Rcpp::NumericVector orig(vector); // keep a copy (as the classic version does)
+
+ // we could query size via
+ // int n = vec.size();
+ // and loop over the vector, but using the STL is so much nicer
+ // so we use a STL transform() algorithm on each element
+ std::transform(orig.begin(), orig.end(), vec.begin(), sqrt);
+
+ Rcpp::Pairlist res(Rcpp::Named( "result", vec),
+ Rcpp::Named( "original", orig));
+
+ return res;
+}
+
+RcppExport SEXP classicRcppVectorExample(SEXP vector) {
+
SEXP rl = R_NilValue; // Use this when there is nothing to be returned.
char *exceptionMesg = NULL;
@@ -62,3 +81,4 @@
return rl;
}
+
More information about the Rcpp-commits
mailing list