[Rcpp-commits] r194 - in pkg: inst inst/examples/RcppInline src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 17 04:54:10 CET 2009
Author: edd
Date: 2009-12-17 04:54:09 +0100 (Thu, 17 Dec 2009)
New Revision: 194
Added:
pkg/inst/examples/RcppInline/RcppSexpTests.r
pkg/src/RcppSexp.cpp
pkg/src/RcppSexp.h
Modified:
pkg/inst/ChangeLog
pkg/src/Rcpp.h
pkg/src/RcppDate.cpp
pkg/src/RcppDate.h
Log:
new RcppSexp class for (currently only scalar) std::string, int, double on entry or exit for easy-to-use SEXP conversion
also added some in new inlined test file RcppSexpTests.r
minor re-formatting and whitespace cleanup for RcppDate
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2009-12-15 17:18:23 UTC (rev 193)
+++ pkg/inst/ChangeLog 2009-12-17 03:54:09 UTC (rev 194)
@@ -1,3 +1,16 @@
+2009-12-16 Dirk Eddelbuettel <edd at debian.org>
+
+ * src/RcppSexp.{h,cpp}: Added simple RcppSexp class for simple
+ conversion from and to single-element SEXPs -- currently limited
+ to int, double, std::string
+ * inst/examples/RcppInline/RcppSexpTests.r: Simple tests for this
+
+2009-12-15 Dirk Eddelbuettel <edd at debian.org>
+
+ * DESCRIPTION: License changed to 'GPL (>= 2)'
+ * COPYING: Changed from LGPL 2.1 to GPL 2 (or later)
+ * src/*.{h,cpp}: Relicensed under GPL 2 (or later)
+
2009-12-13 Dirk Eddelbuettel <edd at debian.org>
* R/RcppInline.R: Extended to for additional header and library
@@ -2,2 +15,3 @@
arguments so that we can work with arbitrary other projects
+ * man/RcppInline.Rd: Added documentation for these arguments
* inst/examples/RcppInline/RcppInlineWithLibsExamples.r: New
Added: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r (rev 0)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r 2009-12-17 03:54:09 UTC (rev 194)
@@ -0,0 +1,37 @@
+#!/usr/bin/r
+
+suppressMessages(library(Rcpp))
+
+cat("===Doubles\n")
+foo <- '
+ double d = RcppSexp(x).asDouble();
+ std::cout << "Returning twice the value of " << d << " : ";
+ return(RcppSexp( 2*d ).asSexp());
+ '
+funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+cat(funx(x=2.123), "\n")
+cat(funx(x=2), "\n")
+##funx(x='2') ## throws as expected
+##funx(x=2:3) ## throws as expected
+
+
+cat("\n===Int\n")
+foo <- '
+ int i = RcppSexp(x).asInt();
+ std::cout << "Returning twice the value of " << i << " : ";
+ return(RcppSexp( 2*i ).asSexp());
+ '
+funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+cat(funx(x=2), "\n")
+cat(funx(x=2.2), "\n")
+
+
+cat("\n===String\n")
+foo <- '
+ std::string s = RcppSexp(x).asStdString();
+ std::cout << "Returning twice the value of " << s << " : ";
+ return(RcppSexp( s+s ).asSexp());
+ '
+funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
+cat(funx(x="abc"), "\n")
+
Property changes on: pkg/inst/examples/RcppInline/RcppSexpTests.r
___________________________________________________________________
Name: svn:executable
+ *
Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h 2009-12-15 17:18:23 UTC (rev 193)
+++ pkg/src/Rcpp.h 2009-12-17 03:54:09 UTC (rev 194)
@@ -36,6 +36,7 @@
#include <RcppNumList.h>
#include <RcppParams.h>
#include <RcppResultSet.h>
+#include <RcppSexp.h>
#include <RcppStringVector.h>
#include <RcppStringVectorView.h>
#include <RcppVector.h>
Modified: pkg/src/RcppDate.cpp
===================================================================
--- pkg/src/RcppDate.cpp 2009-12-15 17:18:23 UTC (rev 193)
+++ pkg/src/RcppDate.cpp 2009-12-17 03:54:09 UTC (rev 194)
@@ -26,22 +26,22 @@
const int RcppDate::QLtoJan1970Offset = 25569; // Offset between R / Unix epoch date and the QL base date
RcppDate::RcppDate() : month(1),
- day(1),
- year(1970) {
- mdy2jdn();
+ day(1),
+ year(1970) {
+ mdy2jdn();
}
RcppDate::RcppDate(int Rjdn) {
- jdn = Rjdn+Jan1970Offset;
- jdn2mdy();
+ jdn = Rjdn+Jan1970Offset;
+ jdn2mdy();
}
RcppDate::RcppDate(int month_, int day_, int year_) : month(month_),
- day(day_),
- year(year_) {
- if (month < 1 || month > 12 || day < 1 || day > 31)
- throw std::range_error("RcppDate: invalid date");
- mdy2jdn();
+ day(day_),
+ year(year_) {
+ if (month < 1 || month > 12 || day < 1 || day > 31)
+ throw std::range_error("RcppDate: invalid date");
+ mdy2jdn();
}
// Print an RcppDate.
Modified: pkg/src/RcppDate.h
===================================================================
--- pkg/src/RcppDate.h 2009-12-15 17:18:23 UTC (rev 193)
+++ pkg/src/RcppDate.h 2009-12-17 03:54:09 UTC (rev 194)
@@ -44,7 +44,6 @@
int getJDN() const { return jdn; }
// Minimal set of date operations.
- // These operators tend to conflict with QuantLib's
friend RcppDate operator+(const RcppDate &date, int offset);
friend int operator-(const RcppDate& date1, const RcppDate& date2);
friend bool operator<(const RcppDate &date1, const RcppDate& date2);
@@ -54,11 +53,6 @@
friend bool operator<=(const RcppDate &date1, const RcppDate& date2);
friend std::ostream& operator<<(std::ostream& os, const RcppDate& date);
-// #ifdef USING_QUANTLIB
-// // Conversions from/to a QuantLib Date.
-// RcppDate(Date dateQL);
-// operator Date() const;
-// #endif
};
#endif
Added: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp (rev 0)
+++ pkg/src/RcppSexp.cpp 2009-12-17 03:54:09 UTC (rev 194)
@@ -0,0 +1,93 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RcppSexp.h: Rcpp R/C++ interface class library -- SEXP support
+//
+// Copyright (C) 2009 Dirk Eddelbuettel
+//
+// 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 <RcppSexp.h>
+
+RcppSexp::RcppSexp(const double & v) {
+ m_sexp = PROTECT(Rf_allocVector(REALSXP, 1));
+ m_nprot++;
+ REAL(m_sexp)[0] = v;
+}
+
+RcppSexp::RcppSexp(const int & v) {
+ m_sexp = PROTECT(Rf_allocVector(INTSXP, 1));
+ m_nprot++;
+ INTEGER(m_sexp)[0] = v;
+}
+
+RcppSexp::RcppSexp(const std::string & v) {
+ m_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
+ m_nprot++;
+ SET_STRING_ELT(m_sexp, 0, Rf_mkChar(v.c_str()));
+}
+
+RcppSexp::~RcppSexp() {
+ UNPROTECT(m_nprot);
+}
+
+double RcppSexp::asDouble() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RcppSexp::asDouble expects single value");
+ }
+ if (!Rf_isNumeric(m_sexp)) {
+ throw std::range_error("RcppSexp::asDouble expect numeric type");
+ }
+ if (Rf_isInteger(m_sexp)) {
+ return (double)INTEGER(m_sexp)[0];
+ } else if (Rf_isReal(m_sexp)) {
+ return REAL(m_sexp)[0];
+ } else {
+ throw std::range_error("RcppSexp::asDouble invalid type");
+ }
+ return 0; // never reached
+}
+
+int RcppSexp::asInt() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RcppSexp::asInt expects single value");
+ }
+ if (!Rf_isNumeric(m_sexp)) {
+ throw std::range_error("RcppSexp::asInt expects numeric type");
+ }
+ if (Rf_isInteger(m_sexp)) {
+ return INTEGER(m_sexp)[0];
+ } else if (Rf_isReal(m_sexp)) {
+ return (int)REAL(m_sexp)[0];
+ } else {
+ std::string mesg = "RcppParams::asInt unknown type";
+ }
+ return 0; // never reached
+}
+
+std::string RcppSexp::asStdString() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RcppSexp::asStdString expects single value");
+ }
+ if (!Rf_isString(m_sexp)) {
+ throw std::range_error("RcppSexp::asStdString expects string");
+ }
+ return std::string(CHAR(STRING_ELT(m_sexp,0)));
+}
+
+SEXP RcppSexp::asSexp() const {
+ return m_sexp;
+}
+
Added: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h (rev 0)
+++ pkg/src/RcppSexp.h 2009-12-17 03:54:09 UTC (rev 194)
@@ -0,0 +1,46 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RcppSexp.h: Rcpp R/C++ interface class library -- SEXP support
+//
+// Copyright (C) 2009 Dirk Eddelbuettel
+//
+// 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/>.
+
+#ifndef RcppSexp_h
+#define RcppSexp_h
+
+#include <RcppCommon.h>
+
+class RcppSexp {
+public:
+ RcppSexp(SEXP sexp, int numprot=0) : m_sexp(sexp), m_nprot(numprot) {}
+ RcppSexp() : m_sexp(R_NilValue), m_nprot(0) {}
+ RcppSexp(const double & v);
+ RcppSexp(const int & v);
+ RcppSexp(const std::string & v);
+ ~RcppSexp();
+
+ double asDouble() const;
+ int asInt() const;
+ std::string asStdString() const;
+ SEXP asSexp() const;
+
+private:
+ SEXP m_sexp;
+ int m_nprot;
+};
+
+#endif
More information about the Rcpp-commits
mailing list