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

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

Author: romain
Date: 2010-01-08 23:53:13 +0100 (Fri, 08 Jan 2010)
New Revision: 327

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.Pairlist.R
   pkg/src/Language.cpp
   pkg/src/Pairlist.cpp
   pkg/src/Rcpp/Language.h
   pkg/src/Rcpp/Pairlist.h
Log:
Pairlist::remove

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-08 20:26:18 UTC (rev 326)
+++ pkg/inst/ChangeLog	2010-01-08 22:53:13 UTC (rev 327)
@@ -6,7 +6,7 @@
 	external pointer
 
 	* src/Rcpp/Pairlist.h: Pairlist gains a push_back, replace,
-	length, size and insert methods
+	length, size, remove and insert methods
 
 	* src/Rcpp/Language.h: idem for Language
 

Modified: pkg/inst/unitTests/runit.Pairlist.R
===================================================================
--- pkg/inst/unitTests/runit.Pairlist.R	2010-01-08 20:26:18 UTC (rev 326)
+++ pkg/inst/unitTests/runit.Pairlist.R	2010-01-08 22:53:13 UTC (rev 327)
@@ -118,3 +118,46 @@
 		pairlist( first = 1, 20.0 , FALSE), msg = "Pairlist::replace" )	
 }
 
+test.Pairlist.size <- function(){
+	funx <- cfunction(signature(), '
+	Pairlist p ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	return wrap( p.size() ) ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), 3L, msg = "Pairlist::size()" )
+}
+
+test.Pairlist.remove <- function(){
+	funx <- cfunction(signature(), '
+	Pairlist p ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	p.remove( 0 ) ;
+	return p ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), pairlist(10.0, 20.0), msg = "Pairlist::remove(0)" )
+	
+	funx <- cfunction(signature(), '
+	Pairlist p ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	p.remove( 2 ) ;
+	return p ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), pairlist(1L, 10.0), msg = "Pairlist::remove(0)" )
+	
+	funx <- cfunction(signature(), '
+	Pairlist p ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	p.remove( 1 ) ;
+	return p ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), pairlist(1L, 20.0), msg = "Pairlist::remove(0)" )
+	
+}

Modified: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp	2010-01-08 20:26:18 UTC (rev 326)
+++ pkg/src/Language.cpp	2010-01-08 22:53:13 UTC (rev 327)
@@ -72,7 +72,7 @@
 	}
 	
 	Language::~Language(){}
-	
+
 	void Language::setSymbol( const std::string& symbol){
 		setSymbol( Symbol( symbol ) ) ;
 	}
@@ -82,5 +82,20 @@
 		SET_TAG(m_sexp, R_NilValue);
 	}
 	
+	void Language::remove( const int& index ) throw(index_out_of_bounds){
+		if( index < 0 || index >= Rf_length(m_sexp) ) throw index_out_of_bounds() ;
+		if( index == 0 ){
+			setSEXP( CDR( m_sexp) ) ;
+			SET_TAG(m_sexp, R_NilValue);
+			SET_TYPEOF( m_sexp, LANGSXP ) ;
+		} else{
+			SEXP x = m_sexp ;
+			int i=1;
+			while( i<index ){ x = CDR(x) ; i++; }
+			SETCDR( x, CDDR(x) ) ;
+		}
+	}
+
+
 	
 } // namespace Rcpp

Modified: pkg/src/Pairlist.cpp
===================================================================
--- pkg/src/Pairlist.cpp	2010-01-08 20:26:18 UTC (rev 326)
+++ pkg/src/Pairlist.cpp	2010-01-08 22:53:13 UTC (rev 327)
@@ -26,7 +26,7 @@
 #include <RcppCommon.h>
 
 namespace Rcpp {
-	
+
 	Pairlist::Pairlist( SEXP x = R_NilValue ) throw(not_compatible) : RObject::RObject( ){
 		if( x != R_NilValue ){
 			switch( TYPEOF(x) ){
@@ -46,11 +46,23 @@
 					}
 			}
 		}          
-		
 	};
-	
+
 	Pairlist::~Pairlist(){}
-	
+
+	void Pairlist::remove( const int& index ) throw(index_out_of_bounds){
+		if( index < 0 || index >= Rf_length(m_sexp) ) throw index_out_of_bounds() ;
+		if( index == 0 ){
+			setSEXP( CDR( m_sexp) ) ;
+		} else{
+			SEXP x = m_sexp ;
+			int i=1;
+			while( i<index ){ x = CDR(x) ; i++; }
+			SETCDR( x, CDDR(x) ) ;
+		}
+	}
+
+
 	SEXP pairlist(){ return R_NilValue ; }
-	
+
 } // namespace Rcpp

Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	2010-01-08 20:26:18 UTC (rev 326)
+++ pkg/src/Rcpp/Language.h	2010-01-08 22:53:13 UTC (rev 327)
@@ -168,7 +168,6 @@
 	 */
 	void setSymbol( const Symbol& symbol ) ;
 
-	
 	/**
 	 * replaces an element of the list
 	 *
@@ -196,11 +195,17 @@
 			UNPROTECT(1) ;
 		}
 	}
-	
+
 	inline size_t length(){ return Rf_length(m_sexp) ; }
 	inline size_t size(){ return Rf_length(m_sexp) ; }
 	
-	
+	/**
+	 * Remove the element at the given position
+	 *
+	 * @param index position where the element is to be removed
+	 */
+	void remove( const int& index ) throw(index_out_of_bounds) ; 
+
 	~Language() ;
 };
 

Modified: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h	2010-01-08 20:26:18 UTC (rev 326)
+++ pkg/src/Rcpp/Pairlist.h	2010-01-08 22:53:13 UTC (rev 327)
@@ -148,10 +148,17 @@
 		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) ; }
-	
+
+	/**
+	 * Remove the element at the given position
+	 *
+	 * @param index position where the element is to be removed
+	 */
+	void remove( const int& index ) throw(index_out_of_bounds) ; 
+
 };
 
 	SEXP pairlist() ;
@@ -170,7 +177,6 @@
 	}
 #endif
 
-	
 } // namespace Rcpp
 
 #endif

_______________________________________________
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