[Rcpp-devel] [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

_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits


More information about the Rcpp-devel mailing list