[Rcpp-commits] r658 - in pkg: inst inst/unitTests src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 10 12:35:48 CET 2010
Author: romain
Date: 2010-02-10 12:35:48 +0100 (Wed, 10 Feb 2010)
New Revision: 658
Modified:
pkg/inst/ChangeLog
pkg/inst/unitTests/runit.GenericVector.R
pkg/src/Rcpp/SEXP_Vector.h
Log:
+SEXP_Vector::insert modelled after vector<>::insert
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2010-02-10 10:47:17 UTC (rev 657)
+++ pkg/inst/ChangeLog 2010-02-10 11:35:48 UTC (rev 658)
@@ -2,10 +2,10 @@
* src/Rcpp/SEXP_Vector.h: SEXP_Vector (and therefore
ExpressionVector and GenericVector, a.k.a List) gain
- methods push_front and push_back that are templated and
+ methods push_front, push_back and insert that are templated and
use the implicit wrap idiom to add an element to the front
- or to the back of the list, pushing other elements. Internally
- the SEXP is actually copied.
+ or, the back or an arbitrary (valid) position of the list,
+ pushing other elements. Internally the SEXP is actually copied.
* src/Rcpp/VectorBase.h: VectorBase gains a version of
offset to support retrieving the offset of a given name of a
Modified: pkg/inst/unitTests/runit.GenericVector.R
===================================================================
--- pkg/inst/unitTests/runit.GenericVector.R 2010-02-10 10:47:17 UTC (rev 657)
+++ pkg/inst/unitTests/runit.GenericVector.R 2010-02-10 11:35:48 UTC (rev 658)
@@ -185,4 +185,19 @@
msg = "List.push_front" )
}
+test.List.insert <- function(){
+
+ funx <- cfunction( signature(x = "list"),
+ '
+ List list(x) ;
+ list.insert( list.begin(), 10 ) ;
+ list.insert( list.end(), Named("foo", "bar" ) ) ;
+ return list ;
+ ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ d <- list( x = 1:10, y = letters[1:10] )
+ res <- funx( d )
+ checkEquals( res,
+ list( 10L, x = 1:10, y = letters[1:10], foo = "bar" ),
+ msg = "List.insert" )
+}
Modified: pkg/src/Rcpp/SEXP_Vector.h
===================================================================
--- pkg/src/Rcpp/SEXP_Vector.h 2010-02-10 10:47:17 UTC (rev 657)
+++ pkg/src/Rcpp/SEXP_Vector.h 2010-02-10 11:35:48 UTC (rev 658)
@@ -98,6 +98,8 @@
inline difference_type operator-(const iterator& y) { return this->proxy.index - y.proxy.index ; }
+ inline int index(){ return proxy.index ; }
+
private:
Proxy proxy ;
};
@@ -166,15 +168,17 @@
template <typename InputIterator>
void assign( InputIterator first, InputIterator last){
+ /* FIXME: we might not need the wrap if the object already
+ has the appropriate length */
setSEXP( r_cast<RTYPE>( wrap( first, last) ) ) ;
}
template <typename WRAPPABLE>
void push_back( const WRAPPABLE& t){
- push_back_sexp( wrap(t), "" ) ;
+ push_back_sexp( wrap(t), false, "" ) ;
}
void push_back( const Named& t){
- push_back_sexp( t.getSEXP() , t.getTag() ) ;
+ push_back_sexp( t.getSEXP() , true, t.getTag() ) ;
}
template <typename WRAPPABLE>
@@ -185,6 +189,24 @@
push_front_sexp( t.getSEXP() , true, t.getTag() ) ;
}
+ template <typename WRAPPABLE>
+ iterator insert( iterator position, const WRAPPABLE& object ){
+ return insert_sexp( position, wrap(object), false, "" ) ;
+ }
+
+ template <typename WRAPPABLE>
+ iterator insert( int index, const WRAPPABLE& object){
+ return insert_sexp( iterator(*this,index), wrap(object), false, "" ) ;
+ }
+
+ iterator insert( iterator position, const Named& object ){
+ return insert_sexp( position, object.getSEXP() , true, object.getTag() ) ;
+ }
+
+ iterator insert( int index, const Named& object){
+ return insert_sexp( iterator(*this,index), object.getSEXP() , true, object.getTag() ) ;
+ }
+
private:
/*
@@ -200,32 +222,7 @@
if( isNULL() ){
set_single( t, named, name );
} else {
- /* not sure we can avoid the copy. R does the same
- with lengthgets at builtin.c */
- R_len_t n = size() ;
- SEXP x = PROTECT( Rf_allocVector( RTYPE, n+1 ) ) ;
- R_len_t i=0 ;
- for( ; i<n; i++){
- SET_VECTOR_ELT( x, i, VECTOR_ELT(m_sexp, i ) ) ;
- }
- SET_VECTOR_ELT( x, i, t ) ;
- SEXP names = RCPP_GET_NAMES( m_sexp ) ;
- if( names != R_NilValue ){
- SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
- for( i=0; i<n; i++){
- SET_STRING_ELT( x_names, i, STRING_ELT(names, i ) ) ;
- }
- SET_STRING_ELT(x_names, i, Rf_mkChar(name.c_str()) ) ;
- Rf_setAttrib( x, Rf_install("names"), x_names );
- UNPROTECT(1) ; /* x_names */
- } else if(named){
- SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
- SET_STRING_ELT(x_names, n, Rf_mkChar(name.c_str()) ) ;
- Rf_setAttrib( x, Rf_install("names"), x_names );
- UNPROTECT(1) ; /* x_names */
- }
- setSEXP( x );
- UNPROTECT(1) ; /* x */
+ push_middle_sexp( size(), t, named, name ) ;
}
}
@@ -233,35 +230,47 @@
if( isNULL() ){
set_single( t, named, name );
} else {
- /* not sure we can avoid the copy. R does the same
- with lengthgets at builtin.c */
- R_len_t n = size() ;
- SEXP x = PROTECT( Rf_allocVector( RTYPE, n+1 ) ) ;
- R_len_t i=0 ;
- SET_VECTOR_ELT( x, 0, t ) ;
- for(i=0 ; i<n; i++){
- SET_VECTOR_ELT( x, i+1, VECTOR_ELT(m_sexp, i ) ) ;
+ push_middle_sexp( 0, t, named, name ) ;
+ }
+ }
+
+ void push_middle_sexp( int index, SEXP t, bool named, const std::string& name ){
+ if( index > size() || index < 0 ) throw RObject::index_out_of_bounds() ;
+ PROTECT(t) ; /* just in case */
+
+ R_len_t n = size() ;
+ SEXP x = PROTECT( Rf_allocVector( RTYPE, n+1 ) ) ;
+ R_len_t i=0 ;
+ for( ; i<index; i++){
+ SET_VECTOR_ELT( x, i, VECTOR_ELT(m_sexp, i ) ) ;
+ }
+ SET_VECTOR_ELT( x, i, t ) ;
+ for( ; i<n; i++){
+ SET_VECTOR_ELT( x, i+1, VECTOR_ELT(m_sexp, i ) ) ;
+ }
+ SEXP names = RCPP_GET_NAMES( m_sexp ) ;
+ if( names != R_NilValue ){
+ SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
+ for( i=0; i<index; i++){
+ SET_STRING_ELT( x_names, i, STRING_ELT(names, i ) ) ;
}
- SEXP names = RCPP_GET_NAMES( m_sexp ) ;
- if( names != R_NilValue ){
- SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
- for( i=0; i<n; i++){
- SET_STRING_ELT( x_names, i+1, STRING_ELT(names, i ) ) ;
- }
- SET_STRING_ELT(x_names, 0, Rf_mkChar(name.c_str()) ) ;
- Rf_setAttrib( x, Rf_install("names"), x_names );
- UNPROTECT(1) ; /* x_names */
- } else if(named){
- SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
- SET_STRING_ELT(x_names, 0, Rf_mkChar(name.c_str()) ) ;
- Rf_setAttrib( x, Rf_install("names"), x_names );
- UNPROTECT(1) ; /* x_names */
+ SET_STRING_ELT( x_names, i, Rf_mkChar(name.c_str()) ) ;
+ for( ; i<n; i++){
+ SET_STRING_ELT( x_names, i+1, STRING_ELT(names, i ) ) ;
}
- setSEXP( x );
- UNPROTECT(1) ; /* x */
+ Rf_setAttrib( x, Rf_install("names"), x_names );
+ UNPROTECT(1) ; /* x_names */
+ } else if(named){
+ SEXP x_names = PROTECT( Rf_allocVector( STRSXP, n+1) );
+ SET_STRING_ELT(x_names, index, Rf_mkChar(name.c_str()) ) ;
+ Rf_setAttrib( x, Rf_install("names"), x_names );
+ UNPROTECT(1) ; /* x_names */
}
+ setSEXP( x );
+ UNPROTECT(2) ; /* t, x */
}
+
void set_single( SEXP t, bool named, const std::string& name ){
SEXP x = PROTECT( Rf_allocVector( RTYPE, 1) );
SET_VECTOR_ELT( x, 0, t ) ;
@@ -273,6 +282,13 @@
setSEXP( x ) ;
UNPROTECT(1) ;
}
+
+ iterator insert_sexp( iterator position, SEXP x, bool named, const std::string& name){
+ push_middle_sexp(position.index(), x, named, name ) ;
+ /* iterators are lazy, so they stay valid */
+ return position ;
+ }
+
} ;
typedef SEXP_Vector<VECSXP> GenericVector ;
More information about the Rcpp-commits
mailing list