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