[Rcpp-commits] r228 - in pkg: . inst inst/examples/RcppInline src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Dec 29 21:18:00 CET 2009
Author: romain
Date: 2009-12-29 21:17:59 +0100 (Tue, 29 Dec 2009)
New Revision: 228
Added:
pkg/src/RObject.cpp
pkg/src/Rcpp_RObject.h
pkg/src/Rcpp_XPtr.h
Removed:
pkg/src/RcppSexp.cpp
pkg/src/RcppSexp.h
pkg/src/RcppXPtr.h
Modified:
pkg/DESCRIPTION
pkg/inst/ChangeLog
pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r
pkg/inst/examples/RcppInline/RcppSexpTests.r
pkg/inst/examples/RcppInline/external_pointer.r
pkg/src/Rcpp.h
pkg/src/RcppExample.cpp
Log:
introduce namespace Rcpp
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/DESCRIPTION 2009-12-29 20:17:59 UTC (rev 228)
@@ -1,6 +1,6 @@
Package: Rcpp
Title: Rcpp R/C++ interface package
-Version: 0.7.0.4
+Version: 0.7.0.5
Date: $Date$
Author: Dirk Eddelbuettel and Romain Francois, with contributions
by Simon Urbanek and David Reiss; based on code written during
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/inst/ChangeLog 2009-12-29 20:17:59 UTC (rev 228)
@@ -1,5 +1,27 @@
2009-12-29 Romain Francois <francoisromain at free.fr>
+ * src/Rcpp_RObject.{h,cpp}: new namespace Rcpp and new class
+ Rcpp::RObject to replace RcppSexp with the same functionality.
+
+ * src/Rcpp_XPtr.h: replaces RcppXPtr.h and the class is now
+ Rcpp::XPtr<> and extends Rcpp::RObject
+
+ * inst/examples/RcppInline/external_pointer.r: use the new namespace
+
+ * inst/examples/RcppInline/RcppInlineWithLibsExamples.r: idem
+
+ * inst/examples/RcppInline/RcppSexpTests.r: idem
+
+ * DESCRIPTION: marked as version 0.7.0.5
+
+ * inst/doc/*: fake (empty) vignette and unit test trigger
+
+ * inst/unitTests/*: prepare the space for unit tests
+
+ * tests/doRUnit.R : added the usual RUnit tests trigger
+
+2009-12-29 Romain Francois <francoisromain at free.fr>
+
* src/RcppXPtr.h: now RcppXPtr extends RcppSexp and RcppSexp manages
garbarge collection, attributes, etc ...
Modified: pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r 2009-12-29 20:17:59 UTC (rev 228)
@@ -1,4 +1,22 @@
#!/usr/bin/r -t
+#
+# Copyright (C) 2009 - 2010 Dirk Eddelbuettel
+# Copyright (C) 2009 - 2010 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/>.
suppressMessages(library(Rcpp))
suppressMessages(library(inline))
@@ -38,7 +56,7 @@
## now use Rcpp to pass down a parameter for the seed
gslrng <- '
- int seed = RcppSexp(par).asInt();
+ int seed = Rcpp::RObject(par).asInt();
gsl_rng *r;
gsl_rng_env_setup();
@@ -56,7 +74,7 @@
#endif
gsl_rng_free(r);
- return RcppSexp(v).asSexp();
+ return Rcpp::RObject(v) ;
'
## turn into a function that R can call
@@ -85,8 +103,8 @@
## now use Rcpp to pass down a parameter for the seed, and a vector size
gslrng <- '
- int seed = RcppSexp(s).asInt();
- int len = RcppSexp(n).asInt();
+ int seed = Rcpp::RObject(s).asInt();
+ int len = Rcpp::RObject(n).asInt();
gsl_rng *r;
gsl_rng_env_setup();
@@ -100,7 +118,7 @@
}
gsl_rng_free(r);
- return RcppSexp(v).asSexp();
+ return Rcpp::RObject(v) ;
'
## turn into a function that R can call
Modified: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r 2009-12-29 20:17:59 UTC (rev 228)
@@ -22,9 +22,9 @@
cat("===Doubles\n")
foo <- '
- double d = RcppSexp(x).asDouble();
+ double d = Rcpp::RObject(x).asDouble();
std::cout << "Returning twice the value of " << d << " : ";
- return(RcppSexp( 2*d ).asSexp());
+ return(Rcpp::RObject( 2*d ) );
'
funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
cat(funx(x=2.123), "\n")
@@ -35,9 +35,9 @@
cat("\n===Int\n")
foo <- '
- int i = RcppSexp(x).asInt();
+ int i = Rcpp::RObject(x).asInt();
std::cout << "Returning twice the value of " << i << " : ";
- return(RcppSexp( 2*i ).asSexp());
+ return(Rcpp::RObject( 2*i ) );
'
funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
cat(funx(x=2), "\n")
@@ -47,18 +47,18 @@
cat("\n===String\n")
foo <- '
- std::string s = RcppSexp(x).asStdString();
+ std::string s = Rcpp::RObject(x).asStdString();
std::cout << "Returning twice the value of " << s << " : ";
- return(RcppSexp( s+s ).asSexp());
+ return(Rcpp::RObject( s+s ) );
'
funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
cat(funx(x="abc"), "\n")
cat("\n===Raw (bytes)\n")
foo <- '
- Rbyte i = RcppSexp(x).asRaw();
+ Rbyte i = Rcpp::RObject(x).asRaw();
std::cout << "Returning twice the value of " << (int)i << " : ";
- return(RcppSexp( (Rbyte)(2*i) ).asSexp());
+ return(Rcpp::RObject( (Rbyte)(2*i) ) );
'
funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
cat( funx(x=2), "\n")
@@ -69,9 +69,9 @@
cat("\n=== logical \n")
foo <- '
-bool b = RcppSexp(x).asBool();
+bool b = Rcpp::RObject(x).asBool();
std::cout << "flip " << ( b ? "TRUE" : "FALSE" ) << " : ";
-return(RcppSexp( !b ).asSexp());
+return(Rcpp::RObject( !b ));
'
funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
cat( res <- funx(x=TRUE) , "\n") ; stopifnot( !res )
@@ -90,7 +90,7 @@
cat("\n===Int Vector via RcppResultSet.getSEXP\n")
foo <- '
- std::vector<int> iv = RcppSexp(x).asStdVectorInt();
+ std::vector<int> iv = Rcpp::RObject(x).asStdVectorInt();
std::cout << "Returning twice the value of vector : ";
for (size_t i=0; i<iv.size(); i++) {
iv[i] = 2*iv[i];
@@ -108,12 +108,12 @@
cat("\n===Int Vector\n")
foo <- '
- std::vector<int> iv = RcppSexp(x).asStdVectorInt();
+ std::vector<int> iv = Rcpp::RObject(x).asStdVectorInt();
std::cout << "Returning twice the value of vector : ";
for (size_t i=0; i<iv.size(); i++) {
iv[i] = 2*iv[i];
}
- return(RcppSexp( iv ).asSexp());
+ return(Rcpp::RObject( iv ) );
'
funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
print(funx(x=2:5+.1))
@@ -125,12 +125,12 @@
cat("\n===Double Vector\n")
foo <- '
- std::vector<double> iv = RcppSexp(x).asStdVectorDouble();
+ std::vector<double> iv = Rcpp::RObject(x).asStdVectorDouble();
std::cout << "Returning twice the value of vector : ";
for (size_t i=0; i<iv.size(); i++) {
iv[i] = 2*iv[i];
}
- return(RcppSexp( iv ).asSexp());
+ return(Rcpp::RObject( iv ));
'
funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
print(funx(x=0.1+2:5))
@@ -141,12 +141,12 @@
cat("\n===Raw Vector\n")
foo <- '
- std::vector<Rbyte> iv = RcppSexp(x).asStdVectorRaw();
+ std::vector<Rbyte> iv = Rcpp::RObject(x).asStdVectorRaw();
std::cout << "Returning twice the value of vector : ";
for (size_t i=0; i<iv.size(); i++) {
iv[i] = 2*iv[i];
}
- return(RcppSexp( iv ).asSexp());
+ return(Rcpp::RObject( iv ));
'
funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
print(funx(x=as.raw(0:9)))
@@ -157,12 +157,12 @@
cat("\n=== vector<bool>\n")
foo <- '
-std::vector<bool> bv = RcppSexp(x).asStdVectorBool();
+std::vector<bool> bv = Rcpp::RObject(x).asStdVectorBool();
std::cout << "Flip the value of vector : ";
for (size_t i=0; i<bv.size(); i++) {
bv[i].flip() ;
}
-return(RcppSexp( bv ).asSexp());
+return(Rcpp::RObject( bv ));
'
funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
print(funx(x=c(TRUE,FALSE)))
@@ -176,12 +176,12 @@
cat("\n===String Vector\n")
foo <- '
- std::vector<std::string> iv = RcppSexp(x).asStdVectorString();
+ std::vector<std::string> iv = Rcpp::RObject(x).asStdVectorString();
std::cout << "Returning twice the value of vector : ";
for (size_t i=0; i<iv.size(); i++) {
iv[i] = iv[i] + iv[i];
}
- return(RcppSexp( iv ).asSexp());
+ return(Rcpp::RObject( iv ));
'
funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
print(funx(x=c("foo", "bar")))
@@ -193,7 +193,7 @@
iv.insert( 0 ) ;
iv.insert( 1 ) ;
iv.insert( 0 ) ;
-return RcppSexp( iv ).asSexp();'
+return Rcpp::RObject( iv );'
funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>" )
print(res <- funx())
stopifnot( identical( res, 0:1 ) )
@@ -204,7 +204,7 @@
ds.insert( 0.0 );
ds.insert( 1.0 );
ds.insert( 0.0 );
-return(RcppSexp( ds ).asSexp()); '
+return(Rcpp::RObject( ds )); '
funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
print( res <- funx() )
stopifnot( identical( res, as.numeric(0:1)))
@@ -215,7 +215,7 @@
bs.insert( (Rbyte)0 ) ;
bs.insert( (Rbyte)1 ) ;
bs.insert( (Rbyte)0 ) ;
-return(RcppSexp( bs ).asSexp()); '
+return(Rcpp::RObject( bs )); '
funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
print( res <- funx() )
stopifnot( identical( res, as.raw(0:1)))
@@ -226,7 +226,7 @@
ss.insert( "foo" ) ;
ss.insert( "bar" ) ;
ss.insert( "foo" ) ;
-return(RcppSexp( ss ).asSexp()); '
+return(Rcpp::RObject( ss )); '
funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, include = "#include <set>" )
print( res <- funx() )
stopifnot( identical( res, c("bar","foo")) )
@@ -236,29 +236,29 @@
funx <- cfunction(
signature(x="data.frame"), '
-std::vector<std::string> iv = RcppSexp(x).attributeNames();
-return(RcppSexp( iv ).asSexp());
+std::vector<std::string> iv = Rcpp::RObject(x).attributeNames();
+return(Rcpp::RObject( iv ));
', Rcpp=TRUE, verbose=FALSE)
res <- funx( iris )
stopifnot( all( c("names", "row.names", "class" ) %in% res ) )
funx <- cfunction(signature(x="data.frame"), '
-bool has_class = RcppSexp(x).hasAttribute( "class" ) ;
-return RcppSexp( has_class ).asSexp() ;
+bool has_class = Rcpp::RObject(x).hasAttribute( "class" ) ;
+return Rcpp::RObject( has_class ) ;
', Rcpp=TRUE, verbose=FALSE)
res <- funx( iris )
stopifnot( res )
funx <- cfunction(signature(x="data.frame"), '
-return RcppSexp(x).attr( "row.names" ) ;
+return Rcpp::RObject(x).attr( "row.names" ) ;
', Rcpp=TRUE, verbose=FALSE)
res <- funx( iris )
stopifnot( identical(res, 1:150) )
#============ NULL
funx <- cfunction(signature(x="ANY"), '
-bool is_null = RcppSexp(x).isNULL() ;
-return RcppSexp( is_null ).asSexp() ;
+bool is_null = Rcpp::RObject(x).isNULL() ;
+return Rcpp::RObject( is_null ) ;
', Rcpp=TRUE, verbose=FALSE)
res <- funx( iris )
stopifnot( !res )
Modified: pkg/inst/examples/RcppInline/external_pointer.r
===================================================================
--- pkg/inst/examples/RcppInline/external_pointer.r 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/inst/examples/RcppInline/external_pointer.r 2009-12-29 20:17:59 UTC (rev 228)
@@ -29,13 +29,12 @@
/* wrap the pointer as an external pointer */
/* this automatically protected the external pointer from R garbage
collection until p goes out of scope. */
- RcppXPtr< std::vector<int> > p(v) ;
+ Rcpp::XPtr< std::vector<int> > p(v) ;
/* return it back to R, since p goes out of scope after the return
the external pointer is no more protected by p, but it gets
protected by being on the R side */
- return( p.asSexp() ) ;
-
+ return( p ) ;
', Rcpp=TRUE, verbose=FALSE)
xp <- funx()
stopifnot( identical( typeof( xp ), "externalptr" ) )
@@ -46,13 +45,13 @@
/* The SEXP based constructor does not protect the SEXP from
garbage collection automatically, it is already protected
because it comes from the R side, however if you want to keep
- the RcppXPtr object on the C(++) side
+ the Rcpp::XPtr object on the C(++) side
and return something else to R, you need to protect the external
pointer, by using the protect member function */
- RcppXPtr< std::vector<int> > p(x) ;
+ Rcpp::XPtr< std::vector<int> > p(x) ;
/* just return the front of the vector as a SEXP */
- return( RcppSexp( p->front() ).asSexp() ) ;
+ return( Rcpp::RObject( p->front() ) ) ;
', Rcpp=TRUE, verbose=FALSE)
front <- funx(xp)
stopifnot( identical( front, 1L ) )
Added: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp (rev 0)
+++ pkg/src/RObject.cpp 2009-12-29 20:17:59 UTC (rev 228)
@@ -0,0 +1,382 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RObject.cpp: Rcpp R/C++ interface class library -- SEXP support
+//
+// Copyright (C) 2009 Dirk Eddelbuettel
+// Copyright (C) 2009 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_RObject.h>
+#include <algorithm>
+
+namespace Rcpp {
+
+RObject::RObject(const bool & v) {
+ logTxt("RObject from bool\n");
+ m_sexp = Rf_ScalarLogical(v);
+ protect() ;
+}
+
+RObject::RObject(const double & v) {
+ logTxt("RObject from double\n");
+ m_sexp = Rf_ScalarReal(v);
+ protect() ;
+}
+
+RObject::RObject(const int & v) {
+ logTxt("RObject from int\n");
+ m_sexp = Rf_ScalarInteger(v);
+ protect() ;
+}
+
+RObject::RObject(const Rbyte & v) {
+ logTxt("RObject from raw\n");
+ m_sexp = Rf_ScalarRaw(v);
+ protect() ;
+}
+
+RObject::RObject(const std::string & v) {
+ logTxt("RObject from std::string\n");
+ m_sexp = Rf_mkString(v.c_str());
+ protect() ;
+}
+
+RObject::RObject(const std::vector<bool> & v) {
+ logTxt("RObject from bool vector\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(LGLSXP, n);
+ protect() ;
+ copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<int> & v) {
+ logTxt("RObject from int vector\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(INTSXP, n);
+ protect() ;
+ copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<double> & v) {
+ logTxt("RObject from double vector\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(REALSXP, n);
+ protect() ;
+ copy( v.begin(), v.end(), REAL(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<Rbyte> & v) {
+ logTxt("RObject from vector<Rbyte> \n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(RAWSXP, n);
+ protect() ;
+ copy( v.begin(), v.end(), RAW(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<std::string> & v) {
+ logTxt("RObject from std::string vector\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(STRSXP, n);
+ protect() ;
+ int i=0;
+ std::vector<std::string>::const_iterator it = v.begin() ;
+ while( i<n ){
+ SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
+ i++ ;
+ it++;
+ }
+}
+
+/* sets */
+
+RObject::RObject(const std::set<int> & v) {
+ logTxt("RObject from set<int>\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(INTSXP, n);
+ protect() ;
+ copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
+}
+
+RObject::RObject(const std::set<double> & v) {
+ logTxt("RObject from set<double>\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(REALSXP, n);
+ protect() ;
+ copy( v.begin(), v.end(), REAL(m_sexp) ) ;
+}
+
+RObject::RObject(const std::set<Rbyte> & v) {
+ logTxt("RObject from set<Rbyte> \n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(RAWSXP, n);
+ protect() ;
+ copy( v.begin(), v.end(), RAW(m_sexp) ) ;
+}
+
+RObject::RObject(const std::set<std::string> & v) {
+ logTxt("RObject from set<string>\n");
+ int n = v.size();
+ m_sexp = Rf_allocVector(STRSXP, n);
+ protect() ;
+ int i=0;
+ std::set<std::string>::iterator it = v.begin();
+ while( i<n ){
+ SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
+ i++ ;
+ it++;
+ }
+}
+
+RObject::~RObject() {
+ release() ;
+ logTxt("~RObject");
+}
+
+double RObject::asDouble() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RObject::asDouble expects single value");
+ }
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? 1.0 : 0.0 ;
+ case REALSXP:
+ return REAL(m_sexp)[0] ;
+ case INTSXP:
+ return (double)INTEGER(m_sexp)[0];
+ case RAWSXP:
+ return (double)RAW(m_sexp)[0];
+ default:
+ throw std::range_error("RObject::asDouble invalid type");
+ }
+ return 0.0 ; // never reached
+}
+
+int RObject::asInt() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RObject::asInt expects single value");
+ }
+ switch( TYPEOF(m_sexp)){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? 1 : 0 ;
+ case REALSXP:
+ return (int)REAL(m_sexp)[0] ; // some of this might be lost
+ case INTSXP:
+ return INTEGER(m_sexp)[0];
+ case RAWSXP:
+ return (int)RAW(m_sexp)[0];
+ default:
+ throw std::range_error("RObject::asInt invalid type");
+ }
+ return 0; // never reached
+}
+
+Rbyte RObject::asRaw() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RObject::asRaw expects single value");
+ }
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? (Rbyte)1 : (Rbyte)0 ;
+ case REALSXP:
+ return (Rbyte)REAL(m_sexp)[0] ;
+ case INTSXP:
+ return (Rbyte)INTEGER(m_sexp)[0] ;
+ case RAWSXP:
+ return RAW(m_sexp)[0] ;
+ default:
+ throw std::range_error("RObject::asRaw expects raw, double or int");
+ }
+ return (Rbyte)0; // never reached
+}
+
+bool RObject::asBool() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RObject::asRaw expects single value");
+ }
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ return LOGICAL(m_sexp)[0] ? true : false ;
+ case REALSXP:
+ return (bool)REAL(m_sexp)[0] ;
+ case INTSXP:
+ return (bool)INTEGER(m_sexp)[0] ;
+ case RAWSXP:
+ return (bool)RAW(m_sexp)[0] ;
+ default:
+ throw std::range_error("RObject::asRaw expects raw, double or int");
+ }
+ return false; // never reached
+}
+
+std::string RObject::asStdString() const {
+ if (Rf_length(m_sexp) != 1) {
+ throw std::range_error("RObject::asStdString expects single value");
+ }
+ if (!Rf_isString(m_sexp)) {
+ throw std::range_error("RObject::asStdString expects string");
+ }
+ return std::string(CHAR(STRING_ELT(m_sexp,0)));
+}
+
+std::vector<bool> RObject::asStdVectorBool() const {
+ int n = Rf_length(m_sexp);
+ std::vector<bool> v(n);
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break ;
+ case INTSXP:
+ v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
+ break;
+ case REALSXP:
+ v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
+ break;
+ case RAWSXP:
+ v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+ break;
+ default:
+ throw std::range_error( "RObject::asStdVectorBool(): invalid R type" ) ;
+ }
+ return v;
+}
+
+
+std::vector<int> RObject::asStdVectorInt() const {
+ int n = Rf_length(m_sexp);
+ std::vector<int> v(n);
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break;
+ case INTSXP:
+ v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
+ break;
+ case REALSXP:
+ v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
+ break;
+ case RAWSXP:
+ v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+ break;
+ default:
+ throw std::range_error( "RObject::asStdVectorInt(): invalid R type" ) ;
+ }
+ return v;
+}
+
+std::vector<Rbyte> RObject::asStdVectorRaw() const {
+ int n = Rf_length(m_sexp);
+ std::vector<Rbyte> v(n);
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break ;
+ case RAWSXP:
+ v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+ break ;
+ case REALSXP:
+ v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
+ break;
+ case INTSXP:
+ v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
+ break;
+ default:
+ std::range_error("RObject::asStdVectorRaw expects raw, double or int");
+ }
+ return v;
+}
+
+std::vector<double> RObject::asStdVectorDouble() const {
+ int n = Rf_length(m_sexp);
+ std::vector<double> v(n);
+ switch( TYPEOF(m_sexp) ){
+ case LGLSXP:
+ v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+ break ;
+ case RAWSXP:
+ v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+ break ;
+ case REALSXP:
+ v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
+ break;
+ case INTSXP:
+ v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
+ break;
+ default:
+ std::range_error("RObject::asStdVectorDouble expects raw, double or int");
+ }
+ return v;
+}
+
+
+std::vector<std::string> RObject::asStdVectorString() const {
+ int n = Rf_length(m_sexp);
+ std::vector<std::string> v(n);
+ if (!Rf_isString(m_sexp)) {
+ throw std::range_error("RObject::asStdVectorString expects string");
+ }
+ for (int i = 0; i < n; i++) {
+ v[i] = std::string(CHAR(STRING_ELT(m_sexp,i)));
+ }
+ return v;
+}
+
+
+
+
+void RObject::protect(){
+ if( !isProtected ){
+ isProtected = true ;
+ R_PreserveObject( m_sexp );
+ }
+}
+
+void RObject::release(){
+ if( isProtected ){
+ R_ReleaseObject(m_sexp);
+ }
+}
+
+std::vector<std::string> RObject::attributeNames() const {
+ /* inspired from do_attributes at attrib.c */
+
+ std::vector<std::string> v ;
+ SEXP attrs = ATTRIB(m_sexp);
+ while( attrs != R_NilValue ){
+ v.push_back( std::string(CHAR(PRINTNAME(TAG(attrs)))) ) ;
+ attrs = CDR( attrs ) ;
+ }
+ return v ;
+}
+
+bool RObject::hasAttribute( const std::string& attr) const {
+ SEXP attrs = ATTRIB(m_sexp);
+ while( attrs != R_NilValue ){
+ if( attr == CHAR(PRINTNAME(TAG(attrs))) ){
+ return true ;
+ }
+ attrs = CDR( attrs ) ;
+ }
+ return false; /* give up */
+}
+
+SEXP RObject::attr( const std::string& name) const{
+ return Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
+}
+
+
+} // namespace Rcpp
+
Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/src/Rcpp.h 2009-12-29 20:17:59 UTC (rev 228)
@@ -36,11 +36,13 @@
#include <RcppNumList.h>
#include <RcppParams.h>
#include <RcppResultSet.h>
-#include <RcppSexp.h>
#include <RcppStringVector.h>
#include <RcppStringVectorView.h>
#include <RcppVector.h>
#include <RcppVectorView.h>
-#include <RcppXPtr.h>
+/* new api */
+#include <Rcpp_RObject.h>
+#include <Rcpp_XPtr.h>
+
#endif
Modified: pkg/src/RcppExample.cpp
===================================================================
--- pkg/src/RcppExample.cpp 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/src/RcppExample.cpp 2009-12-29 20:17:59 UTC (rev 228)
@@ -466,12 +466,12 @@
std::vector<int> *v = new std::vector<int> ;
v->push_back( 1 ) ;
v->push_back( 2 ) ;
- RcppXPtr< std::vector<int> > p(v) ;
+ Rcpp::XPtr< std::vector<int> > p(v) ;
return p.asSexp() ;
}
RcppExport SEXP RcppXPtrExample_get_external_pointer(SEXP x){
- RcppXPtr< std::vector<int> > p(x) ;
+ Rcpp::XPtr< std::vector<int> > p(x) ;
return Rf_ScalarInteger( p->back( ) ) ;
}
Deleted: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp 2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/src/RcppSexp.cpp 2009-12-29 20:17:59 UTC (rev 228)
@@ -1,377 +0,0 @@
-// -*- 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
-// Copyright (C) 2009 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 <RcppSexp.h>
-#include <algorithm>
-
-RcppSexp::RcppSexp(const bool & v) {
- logTxt("RcppSexp from bool\n");
- m_sexp = Rf_ScalarLogical(v);
- protect() ;
-}
-
-RcppSexp::RcppSexp(const double & v) {
- logTxt("RcppSexp from double\n");
- m_sexp = Rf_ScalarReal(v);
- protect() ;
-}
-
-RcppSexp::RcppSexp(const int & v) {
- logTxt("RcppSexp from int\n");
- m_sexp = Rf_ScalarInteger(v);
- protect() ;
-}
-
-RcppSexp::RcppSexp(const Rbyte & v) {
- logTxt("RcppSexp from raw\n");
- m_sexp = Rf_ScalarRaw(v);
- protect() ;
-}
-
-RcppSexp::RcppSexp(const std::string & v) {
- logTxt("RcppSexp from std::string\n");
- m_sexp = Rf_mkString(v.c_str());
- protect() ;
-}
-
-RcppSexp::RcppSexp(const std::vector<bool> & v) {
- logTxt("RcppSexp from bool vector\n");
- int n = v.size();
- m_sexp = Rf_allocVector(LGLSXP, n);
- protect() ;
- copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<int> & v) {
- logTxt("RcppSexp from int vector\n");
- int n = v.size();
- m_sexp = Rf_allocVector(INTSXP, n);
- protect() ;
- copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<double> & v) {
- logTxt("RcppSexp from double vector\n");
- int n = v.size();
- m_sexp = Rf_allocVector(REALSXP, n);
- protect() ;
- copy( v.begin(), v.end(), REAL(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<Rbyte> & v) {
- logTxt("RcppSexp from vector<Rbyte> \n");
- int n = v.size();
- m_sexp = Rf_allocVector(RAWSXP, n);
- protect() ;
- copy( v.begin(), v.end(), RAW(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<std::string> & v) {
- logTxt("RcppSexp from std::string vector\n");
- int n = v.size();
- m_sexp = Rf_allocVector(STRSXP, n);
- protect() ;
- int i=0;
- std::vector<std::string>::const_iterator it = v.begin() ;
- while( i<n ){
- SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
- i++ ;
- it++;
- }
-}
-
-/* sets */
-
-RcppSexp::RcppSexp(const std::set<int> & v) {
- logTxt("RcppSexp from set<int>\n");
- int n = v.size();
- m_sexp = Rf_allocVector(INTSXP, n);
- protect() ;
- copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::set<double> & v) {
- logTxt("RcppSexp from set<double>\n");
- int n = v.size();
- m_sexp = Rf_allocVector(REALSXP, n);
- protect() ;
- copy( v.begin(), v.end(), REAL(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::set<Rbyte> & v) {
- logTxt("RcppSexp from set<Rbyte> \n");
- int n = v.size();
- m_sexp = Rf_allocVector(RAWSXP, n);
- protect() ;
- copy( v.begin(), v.end(), RAW(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::set<std::string> & v) {
- logTxt("RcppSexp from set<string>\n");
- int n = v.size();
- m_sexp = Rf_allocVector(STRSXP, n);
- protect() ;
- int i=0;
- std::set<std::string>::iterator it = v.begin();
- while( i<n ){
- SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
- i++ ;
- it++;
- }
-}
-
-RcppSexp::~RcppSexp() {
- release() ;
- logTxt("~RcppSexp");
-}
-
-double RcppSexp::asDouble() const {
- if (Rf_length(m_sexp) != 1) {
- throw std::range_error("RcppSexp::asDouble expects single value");
- }
- switch( TYPEOF(m_sexp) ){
- case LGLSXP:
- return LOGICAL(m_sexp)[0] ? 1.0 : 0.0 ;
- case REALSXP:
- return REAL(m_sexp)[0] ;
- case INTSXP:
- return (double)INTEGER(m_sexp)[0];
- case RAWSXP:
- return (double)RAW(m_sexp)[0];
- default:
- throw std::range_error("RcppSexp::asDouble invalid type");
- }
- return 0.0 ; // never reached
-}
-
-int RcppSexp::asInt() const {
- if (Rf_length(m_sexp) != 1) {
- throw std::range_error("RcppSexp::asInt expects single value");
- }
- switch( TYPEOF(m_sexp)){
- case LGLSXP:
- return LOGICAL(m_sexp)[0] ? 1 : 0 ;
- case REALSXP:
- return (int)REAL(m_sexp)[0] ; // some of this might be lost
- case INTSXP:
- return INTEGER(m_sexp)[0];
- case RAWSXP:
- return (int)RAW(m_sexp)[0];
- default:
- throw std::range_error("RcppSexp::asInt invalid type");
- }
- return 0; // never reached
-}
-
-Rbyte RcppSexp::asRaw() const {
- if (Rf_length(m_sexp) != 1) {
- throw std::range_error("RcppSexp::asRaw expects single value");
- }
- switch( TYPEOF(m_sexp) ){
- case LGLSXP:
- return LOGICAL(m_sexp)[0] ? (Rbyte)1 : (Rbyte)0 ;
- case REALSXP:
- return (Rbyte)REAL(m_sexp)[0] ;
- case INTSXP:
- return (Rbyte)INTEGER(m_sexp)[0] ;
- case RAWSXP:
- return RAW(m_sexp)[0] ;
- default:
- throw std::range_error("RcppSexp::asRaw expects raw, double or int");
- }
- return (Rbyte)0; // never reached
-}
-
-bool RcppSexp::asBool() const {
- if (Rf_length(m_sexp) != 1) {
- throw std::range_error("RcppSexp::asRaw expects single value");
- }
- switch( TYPEOF(m_sexp) ){
- case LGLSXP:
- return LOGICAL(m_sexp)[0] ? true : false ;
- case REALSXP:
- return (bool)REAL(m_sexp)[0] ;
- case INTSXP:
- return (bool)INTEGER(m_sexp)[0] ;
- case RAWSXP:
- return (bool)RAW(m_sexp)[0] ;
- default:
- throw std::range_error("RcppSexp::asRaw expects raw, double or int");
- }
- return false; // 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)));
-}
-
-std::vector<bool> RcppSexp::asStdVectorBool() const {
- int n = Rf_length(m_sexp);
- std::vector<bool> v(n);
- switch( TYPEOF(m_sexp) ){
- case LGLSXP:
- v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
- break ;
- case INTSXP:
- v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
- break;
- case REALSXP:
- v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
- break;
- case RAWSXP:
- v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
- break;
- default:
- throw std::range_error( "RcppSexp::asStdVectorBool(): invalid R type" ) ;
- }
- return v;
-}
-
-
-std::vector<int> RcppSexp::asStdVectorInt() const {
- int n = Rf_length(m_sexp);
- std::vector<int> v(n);
- switch( TYPEOF(m_sexp) ){
- case LGLSXP:
- v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
- break;
- case INTSXP:
- v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
- break;
- case REALSXP:
- v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
- break;
- case RAWSXP:
- v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
- break;
- default:
- throw std::range_error( "RcppSexp::asStdVectorInt(): invalid R type" ) ;
- }
- return v;
-}
-
-std::vector<Rbyte> RcppSexp::asStdVectorRaw() const {
- int n = Rf_length(m_sexp);
- std::vector<Rbyte> v(n);
- switch( TYPEOF(m_sexp) ){
- case LGLSXP:
- v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
- break ;
- case RAWSXP:
- v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
- break ;
- case REALSXP:
- v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
- break;
- case INTSXP:
- v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
- break;
- default:
- std::range_error("RcppSexp::asStdVectorRaw expects raw, double or int");
- }
- return v;
-}
-
-std::vector<double> RcppSexp::asStdVectorDouble() const {
- int n = Rf_length(m_sexp);
- std::vector<double> v(n);
- switch( TYPEOF(m_sexp) ){
- case LGLSXP:
- v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
- break ;
- case RAWSXP:
- v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
- break ;
- case REALSXP:
- v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
- break;
- case INTSXP:
- v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
- break;
- default:
- std::range_error("RcppSexp::asStdVectorDouble expects raw, double or int");
- }
- return v;
-}
-
-
-std::vector<std::string> RcppSexp::asStdVectorString() const {
- int n = Rf_length(m_sexp);
- std::vector<std::string> v(n);
- if (!Rf_isString(m_sexp)) {
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 228
More information about the Rcpp-commits
mailing list