[Rcpp-devel] [Rcpp-commits] r214 - in pkg: inst inst/examples/RcppInline src

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

Author: romain
Date: 2009-12-27 17:23:08 +0100 (Sun, 27 Dec 2009)
New Revision: 214

Modified:
   pkg/inst/ChangeLog
   pkg/inst/examples/RcppInline/RcppSexpTests.r
   pkg/src/RcppSexp.cpp
   pkg/src/RcppSexp.h
Log:
added some methods to deal with attributes and to test if m_sexp is NULL

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2009-12-27 09:09:26 UTC (rev 213)
+++ pkg/inst/ChangeLog	2009-12-27 16:23:08 UTC (rev 214)
@@ -1,10 +1,18 @@
 2009-12-27  Romain Francois <francoisromain at free.fr>
+	
+	* src/RcppSexp.{h,cpp} : added method isNULL to test if the 
+	underlying SEXP is NULL
+	
+	* src/RcppSexp.{h,cpp} : added some methods to deal with attributes
+	attributeNames : the names of the attributes as a vector<string>
+	hasAttribute   : test whether the SEXP has the given attribute
+	attr           : extract the attribute (might return NULL)
 
 	* src/RcppSexp.{h,cpp} : added RcppSexp(bool), RcppSexp(vector<bool>)
 	constructors and RcppSexp.asBool(), RcppSexp.asStdVectorBool() methods
 
 	* inst/examples/RcppInline/RcppSexpTests.r: examples/tests of the
-	above
+	above items
 
 2009-12-26  Romain Francois <francoisromain at free.fr>
 

Modified: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-27 09:09:26 UTC (rev 213)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-27 16:23:08 UTC (rev 214)
@@ -213,3 +213,39 @@
 print( res <- funx() )
 stopifnot( identical( res, c("bar","foo")) )
 
+
+#========= attributes 
+
+funx <- cfunction(
+	signature(x="data.frame"), '
+std::vector<std::string> iv = RcppSexp(x).attributeNames();
+return(RcppSexp( iv ).asSexp());
+', 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() ;
+', Rcpp=TRUE, verbose=FALSE)
+res <- funx( iris )
+stopifnot( res )
+
+funx <- cfunction(signature(x="data.frame"), '
+return RcppSexp(x).attr( "row.names" ).asSexp() ;
+', 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() ;
+', Rcpp=TRUE, verbose=FALSE)
+res <- funx( iris )
+stopifnot( !res )
+res <- funx( NULL )
+stopifnot( res )
+
+
+

Modified: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp	2009-12-27 09:09:26 UTC (rev 213)
+++ pkg/src/RcppSexp.cpp	2009-12-27 16:23:08 UTC (rev 214)
@@ -343,3 +343,35 @@
     return v;
 }
 
+std::vector<std::string> RcppSexp::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 RcppSexp::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 */
+}
+
+RcppSexp RcppSexp::attr( const std::string& name) const{
+	SEXP att = Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
+	return RcppSexp( att ) ;
+}
+
+bool RcppSexp::isNULL() const{
+	return m_sexp == R_NilValue ;
+}
+

Modified: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h	2009-12-27 09:09:26 UTC (rev 213)
+++ pkg/src/RcppSexp.h	2009-12-27 16:23:08 UTC (rev 214)
@@ -60,6 +60,14 @@
     std::vector<bool>        asStdVectorBool() const;
     SEXP                     asSexp() const;
     
+    /* attributes */
+    std::vector<std::string> attributeNames() const ;
+    bool hasAttribute( const std::string& attr) const ; 
+    RcppSexp attr( const std::string& name) const ;
+    
+    /* NULL */
+    bool isNULL() const ;
+    
 private:
     SEXP m_sexp;
 };

_______________________________________________
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