[Rcpp-commits] r318 - in pkg: inst inst/unitTests src/Rcpp

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Jan 8 19:20:13 CET 2010


Author: romain
Date: 2010-01-08 19:20:13 +0100 (Fri, 08 Jan 2010)
New Revision: 318

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.Pairlist.R
   pkg/inst/unitTests/runit.XPTr.R
   pkg/src/Rcpp/Language.h
   pkg/src/Rcpp/Pairlist.h
   pkg/src/Rcpp/wrap.h
Log:
added Pairlist::replace

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-08 15:34:21 UTC (rev 317)
+++ pkg/inst/ChangeLog	2010-01-08 18:20:13 UTC (rev 318)
@@ -1,8 +1,13 @@
 2010-01-08  Romain Francois <francoisromain at free.fr>
 
-	* src/Rcpp/Pairlist.h: Pairlist gains a push_back 
-	and insert methods
+	* src/Rcpp/wrap.h: added wrap( size_t ) to disambiguate it
 
+	* int/unitTests/runit.XPTr.R: forgot to set the finalizer on the
+	external pointer
+
+	* src/Rcpp/Pairlist.h: Pairlist gains a push_back, replace,
+	length, size and insert methods
+
 	* src/Rcpp/Language.h: idem for Language
 
 2010-01-07  Romain Francois <francoisromain at free.fr>

Modified: pkg/inst/unitTests/runit.Pairlist.R
===================================================================
--- pkg/inst/unitTests/runit.Pairlist.R	2010-01-08 15:34:21 UTC (rev 317)
+++ pkg/inst/unitTests/runit.Pairlist.R	2010-01-08 18:20:13 UTC (rev 318)
@@ -103,5 +103,18 @@
 		msg = "Pairlist::replace" )
 }
 
+test.Pairlist.replace <- function(){
+	funx <- cfunction(signature(), '
+	Pairlist p ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	p.replace( 0, Named( "first", 1 ) ) ;
+	p.replace( 1, 20.0 ) ;
+	p.replace( 2, false ) ;
+	return p ;', 
+	Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(),
+		pairlist( first = 1, 20.0 , FALSE), msg = "Pairlist::replace" )	
+}
 
-

Modified: pkg/inst/unitTests/runit.XPTr.R
===================================================================
--- pkg/inst/unitTests/runit.XPTr.R	2010-01-08 15:34:21 UTC (rev 317)
+++ pkg/inst/unitTests/runit.XPTr.R	2010-01-08 18:20:13 UTC (rev 318)
@@ -32,7 +32,7 @@
 		/* wrap the pointer as an external pointer */
 		/* this automatically protected the external pointer from R garbage 
 		   collection until p goes out of scope. */
-		Rcpp::XPtr< std::vector<int> > p(v) ;
+		Rcpp::XPtr< std::vector<int> > p(v, true) ;
 		
 		/* 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 

Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	2010-01-08 15:34:21 UTC (rev 317)
+++ pkg/src/Rcpp/Language.h	2010-01-08 18:20:13 UTC (rev 318)
@@ -115,7 +115,8 @@
 	}
 
 	/**
-	 * wraps an object and add it in front of the pairlist
+	 * wraps an object and add it in front of the pairlist. 
+	 * in addition, the tag is set to NULL and the SEXPTYPE to LANGSXP
 	 *
 	 * @param object anything that can be wrapped by one 
 	 * of the wrap functions, or an object of class Named
@@ -127,7 +128,13 @@
 		SET_TYPEOF(m_sexp, LANGSXP);
 	}
 
-
+	/**
+	 * insert an object at the given position, pushing other objects
+	 * to the tail of the list
+	 *
+	 * @param index index (0-based) where to insert
+	 * @param object object to wrap
+	 */
 	template <typename T>
 	void insert( const int& index, const T& object) throw(index_out_of_bounds) {
 		if( index == 0 ) {
@@ -161,6 +168,39 @@
 	 */
 	void setSymbol( const Symbol& symbol ) ;
 
+	
+	/**
+	 * replaces an element of the list
+	 *
+	 * @param index position
+	 * @param object object that can be wrapped
+	 */
+	template <typename T>
+	void replace( const int& index, const T& object ) throw(index_out_of_bounds){
+		if( index < 0 || index >= Rf_length(m_sexp) ) throw index_out_of_bounds() ;
+		
+		if( index == 0 ){
+			/* special handling */
+			SEXP x = PROTECT(pairlist( object ));
+			SETCAR( m_sexp, CAR(x) );
+			UNPROTECT(1) ;
+		} else{
+			/* pretend we do a pairlist so that we get Named to work for us */
+			SEXP x = PROTECT(pairlist( object ));
+			SEXP y = m_sexp ;
+			int i=0;
+			while( i<index ){ y = CDR(y) ; i++; }
+			
+			SETCAR( y, CAR(x) );
+			SET_TAG( y, TAG(x) );
+			UNPROTECT(1) ;
+		}
+	}
+	
+	inline size_t length(){ return Rf_length(m_sexp) ; }
+	inline size_t size(){ return Rf_length(m_sexp) ; }
+	
+	
 	~Language() ;
 };
 

Modified: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h	2010-01-08 15:34:21 UTC (rev 317)
+++ pkg/src/Rcpp/Pairlist.h	2010-01-08 18:20:13 UTC (rev 318)
@@ -99,6 +99,13 @@
 		}
 	}
 	
+	/**
+	 * insert an object at the given position, pushing other objects
+	 * to the tail of the list
+	 *
+	 * @param index index (0-based) where to insert
+	 * @param object object to wrap
+	 */
 	template <typename T>
 	void insert( const int& index, const T& object) throw(index_out_of_bounds) {
 		if( index == 0 ) {
@@ -121,23 +128,49 @@
 		}
 	}
 	
-
+	/**
+	 * replaces an element of the list
+	 *
+	 * @param index position
+	 * @param object object that can be wrapped
+	 */
+	template <typename T>
+	void replace( const int& index, const T& object ) throw(index_out_of_bounds){
+		if( index < 0 || index >= Rf_length(m_sexp) ) throw index_out_of_bounds() ;
+		
+		/* pretend we do a pairlist so that we get Named to work for us */
+		SEXP x = PROTECT(pairlist( object ));
+		SEXP y = m_sexp ;
+		int i=0;
+		while( i<index ){ y = CDR(y) ; i++; }
+		
+		SETCAR( y, CAR(x) );
+		SET_TAG( y, TAG(x) );
+		UNPROTECT(1) ;
+	}
+	
+	inline size_t length(){ return Rf_length(m_sexp) ; }
+	inline size_t size(){ return Rf_length(m_sexp) ; }
+	
 };
 
-#ifdef HAS_VARIADIC_TEMPLATES
 	SEXP pairlist() ;
-	template<typename T, typename... Args>
-	SEXP pairlist( const T& first, const Args&... args ){
-		return grow(first, pairlist(args...) ) ;
-	}
- 	/* end of the recursion, wrap first to make the CAR and use 
+
+	/* end of the recursion, wrap first to make the CAR and use 
  	   R_NilValue as the CDR of the list */
 	template<typename T>
 	SEXP pairlist( const T& first){
 		return grow(first, R_NilValue ) ; 
 	}
+
+#ifdef HAS_VARIADIC_TEMPLATES
+	template<typename T, typename... Args>
+	SEXP pairlist( const T& first, const Args&... args ){
+		return grow(first, pairlist(args...) ) ;
+	}
 #endif
 
+	
 } // namespace Rcpp
 
 #endif

Modified: pkg/src/Rcpp/wrap.h
===================================================================
--- pkg/src/Rcpp/wrap.h	2010-01-08 15:34:21 UTC (rev 317)
+++ pkg/src/Rcpp/wrap.h	2010-01-08 18:20:13 UTC (rev 318)
@@ -45,6 +45,7 @@
 LogicalVector wrap(const bool & v); 
 NumericVector wrap(const double & v);
 IntegerVector wrap(const int & v);
+inline IntegerVector wrap(const size_t & v){ return wrap( (int)v ) } ;
 RawVector wrap(const Rbyte & v);
 
 IntegerVector wrap(const std::vector<int> & v);



More information about the Rcpp-commits mailing list