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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jan 7 15:19:03 CET 2010


Author: romain
Date: 2010-01-07 15:19:02 +0100 (Thu, 07 Jan 2010)
New Revision: 299

Added:
   pkg/inst/unitTests/runit.ExpressionVector.R
   pkg/src/ExpressionVector.cpp
   pkg/src/Rcpp/ExpressionVector.h
Modified:
   pkg/inst/ChangeLog
   pkg/src/GenericVector.cpp
   pkg/src/Language.cpp
   pkg/src/Rcpp.h
   pkg/src/Rcpp/GenericVector.h
Log:
new class Rcpp::ExpressionVector

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-07 13:25:46 UTC (rev 298)
+++ pkg/inst/ChangeLog	2010-01-07 14:19:02 UTC (rev 299)
@@ -1,5 +1,10 @@
 2010-01-07  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/ExpressionVector.h: new class Rcpp::ExpressionVector
+	which shares a lot with GenericVector.
+	* src/ExpressionVector.cpp: implementation
+	* inst/unitTests/runit.ExpressionVector.R: unit tests
+
 	* src/Rcpp/CharacterVector.h: new class Rcpp::CharacterVector
 	to manage character vectors (STRSXP). StringVector is a 
 	convenience typedef equivalent to CharacterVector

Added: pkg/inst/unitTests/runit.ExpressionVector.R
===================================================================
--- pkg/inst/unitTests/runit.ExpressionVector.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.ExpressionVector.R	2010-01-07 14:19:02 UTC (rev 299)
@@ -0,0 +1,52 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+#
+# This file is part of Rcpp.
+#
+# Rcpp is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# Rcpp is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+.setUp <- function(){
+	suppressMessages( require( inline ) )
+}
+
+test.ExpressionVector <- function(){
+	funx <- cfunction(signature(), '
+	ExpressionVector x(2) ;
+	x[0] = Symbol( "rnorm" ) ;
+	x[1] = Rf_lcons( Symbol("rnorm"), Rf_cons( Rf_ScalarReal(10.0), R_NilValue) ) ;
+	return x ;', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	ex <- parse( text = "rnorm; rnorm(10)" )
+	# get rid of the srcref stuff so that we can compare
+	# more easily
+	attributes(ex) <- NULL 
+	checkEquals( funx(),  ex , msg = "ExpressionVector" )
+}
+
+if( Rcpp:::capabilities()[["variadic templates"]] ){
+	test.ExpressionVector.variadic <- function(){
+		funx <- cfunction(signature(), '
+		ExpressionVector x(2) ;
+		x[0] = Symbol( "rnorm" ) ;
+		x[1] = Language( "rnorm", 10.0 ) ;
+		return x ;', 
+			Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+		ex <- parse( text = "rnorm; rnorm(10)" )
+		attributes(ex) <- NULL
+		checkEquals( funx(),  ex , msg = "ExpressionVector (using variadic templates) " )
+	}
+}
+
+

Added: pkg/src/ExpressionVector.cpp
===================================================================
--- pkg/src/ExpressionVector.cpp	                        (rev 0)
+++ pkg/src/ExpressionVector.cpp	2010-01-07 14:19:02 UTC (rev 299)
@@ -0,0 +1,99 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// ExpressionVector.cpp: Rcpp R/C++ interface class library -- expression vectors
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+#include <Rcpp/ExpressionVector.h>
+#include <Rcpp/Evaluator.h>
+#include <Rcpp/Symbol.h>
+#include <algorithm>
+
+namespace Rcpp{
+	
+	ExpressionVector::ExpressionVector(SEXP x) throw(not_compatible) : RObject() {
+		switch( TYPEOF( x ) ){
+			case EXPRSXP:
+				setSEXP( x ) ;
+				break ;
+			default:
+				{
+					Evaluator e( Rf_lang2( Symbol("as.expression"), x ) ) ;
+					e.run() ;
+					if( e.successfull() ){
+						setSEXP( e.getResult() ) ;
+					} else{
+						throw not_compatible( "could not convert to an expression vector" ) ;
+					}
+				}
+		}
+	}
+	
+	ExpressionVector::ExpressionVector(int size) : RObject() {
+		setSEXP( Rf_allocVector(EXPRSXP, size) ) ;
+	}
+
+#ifdef HAS_INIT_LISTS
+	ExpressionVector::ExpressionVector( std::initializer_list<RObject> list ) {
+		SEXP x = PROTECT( Rf_allocVector( EXPRSXP, list.size() ) ) ;
+		const RObject* p = list.begin() ;
+		for( int i=0; i<list.size() ; i++, p++){
+			SET_VECTOR_ELT( x, i, p->asSexp() ) ;
+		}
+		setSEXP( x ) ;
+		UNPROTECT( 1 ); /* x */
+	}
+#endif
+
+SEXP* ExpressionVector::begin(){
+	return RCPP_VECTOR_PTR(m_sexp) ;
+}
+
+SEXP* ExpressionVector::end(){
+	return RCPP_VECTOR_PTR(m_sexp) + LENGTH(m_sexp) ;
+}
+
+/* proxy stuff */
+
+ExpressionVector::Proxy::Proxy(ExpressionVector& v, int i) :
+	parent(v), index(i){}
+
+ExpressionVector::Proxy::operator SEXP() const{
+	return VECTOR_ELT( parent, index ) ;
+}
+
+ExpressionVector::Proxy& ExpressionVector::Proxy::operator=( const Proxy& rhs){
+	SET_VECTOR_ELT( parent, index, VECTOR_ELT( rhs.parent, rhs.index) ) ;
+}
+
+ExpressionVector::Proxy& ExpressionVector::Proxy::operator=( SEXP rhs){
+	SET_VECTOR_ELT( parent, index, rhs ) ;
+}
+
+const ExpressionVector::Proxy ExpressionVector::operator[](int i) const {
+	return Proxy(const_cast<ExpressionVector&>(*this), i) ;
+}
+
+ExpressionVector::Proxy ExpressionVector::operator[](int i) {
+	return Proxy(*this, i ) ;
+}
+
+
+} // namespace 

Modified: pkg/src/GenericVector.cpp
===================================================================
--- pkg/src/GenericVector.cpp	2010-01-07 13:25:46 UTC (rev 298)
+++ pkg/src/GenericVector.cpp	2010-01-07 14:19:02 UTC (rev 299)
@@ -22,6 +22,8 @@
 #include <RcppCommon.h>
 #include <Rcpp/RObject.h>
 #include <Rcpp/GenericVector.h>
+#include <Rcpp/Evaluator.h>
+#include <Rcpp/Symbol.h>
 #include <algorithm>
 
 namespace Rcpp{
@@ -32,7 +34,15 @@
 				setSEXP( x ) ;
 				break ;
 			default:
-				throw not_compatible( "not a list" ) ;
+				{
+					Evaluator e( Rf_lang2( Symbol("as.list"), x ) ) ;
+					e.run() ;
+					if( e.successfull() ){
+						setSEXP( e.getResult() ) ;
+					} else{
+						throw not_compatible( "could not convert to a list" ) ;
+					}
+				}
 		}
 	}
 	
@@ -52,14 +62,6 @@
 	}
 #endif
 
-SEXP GenericVector::get( const int& i ) const { 
-	return VECTOR_ELT(m_sexp, i) ;
-}
-
-void GenericVector::set( const int& i, SEXP value ){
-	SET_VECTOR_ELT(m_sexp,i,value) ;
-}
-
 SEXP* GenericVector::begin(){
 	return RCPP_VECTOR_PTR(m_sexp) ;
 }

Modified: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp	2010-01-07 13:25:46 UTC (rev 298)
+++ pkg/src/Language.cpp	2010-01-07 14:19:02 UTC (rev 299)
@@ -60,7 +60,7 @@
 		} else{
 			setSEXP( lang ) ;
 		}
-		
+
 	};
 	
 	Language::Language( const std::string& symbol ): RObject::RObject(R_NilValue) {

Added: pkg/src/Rcpp/ExpressionVector.h
===================================================================
--- pkg/src/Rcpp/ExpressionVector.h	                        (rev 0)
+++ pkg/src/Rcpp/ExpressionVector.h	2010-01-07 14:19:02 UTC (rev 299)
@@ -0,0 +1,89 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// ExpressionVector.h: Rcpp R/C++ interface class library -- expression vectors
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_ExpressionVector_h
+#define Rcpp_ExpressionVector_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+
+#ifdef HAS_INIT_LISTS
+#include <initializer_list>
+#include <algorithm>
+#endif
+
+namespace Rcpp{ 
+
+class ExpressionVector : public RObject {     
+public:
+
+	/* much inspired from item 30 of more effective C++ */
+	class Proxy {
+	public:
+		Proxy( ExpressionVector& v, int index ) ;
+		
+		/* lvalue uses */
+		Proxy& operator=(const Proxy& rhs) ;
+		Proxy& operator=(SEXP rhs) ;
+
+		template <typename T>
+		Proxy& operator=( const T& rhs){
+			SET_VECTOR_ELT( parent, index, wrap(rhs) ) ;
+		}
+
+		/* rvalue use */
+		operator SEXP() const ;
+
+	private:
+		ExpressionVector& parent; 
+		int index ;
+	} ;
+
+	ExpressionVector(SEXP x) throw(not_compatible);
+	ExpressionVector( int size) ;
+	
+#ifdef HAS_INIT_LISTS	
+	ExpressionVector( std::initializer_list<RObject> list ) ;
+#endif
+
+	/**
+	 * the length of the vector, uses Rf_length
+	 */
+	inline int length() const { return Rf_length( m_sexp ) ; }
+
+	/**
+	 * alias of length
+	 */
+	inline int size() const { return Rf_length( m_sexp ) ; }
+
+	SEXP* begin(); 
+	SEXP* end() ;
+
+	const Proxy operator[]( int i ) const ;
+	Proxy operator[]( int i ) ;
+
+	friend class Proxy; 
+
+} ;
+
+} // namespace
+
+#endif

Modified: pkg/src/Rcpp/GenericVector.h
===================================================================
--- pkg/src/Rcpp/GenericVector.h	2010-01-07 13:25:46 UTC (rev 298)
+++ pkg/src/Rcpp/GenericVector.h	2010-01-07 14:19:02 UTC (rev 299)
@@ -75,9 +75,6 @@
 	 */
 	inline int size() const { return Rf_length( m_sexp ) ; }
 	
-	SEXP get(const int& i) const ;
-	void set(const int& i, SEXP value ) ;
-	
 	SEXP* begin(); 
 	SEXP* end() ;
 	

Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h	2010-01-07 13:25:46 UTC (rev 298)
+++ pkg/src/Rcpp.h	2010-01-07 14:19:02 UTC (rev 299)
@@ -63,5 +63,7 @@
 #include <Rcpp/GenericVector.h>
 #include <Rcpp/WeakReference.h>
 #include <Rcpp/CharacterVector.h>
+#include <Rcpp/ExpressionVector.h>
 
+
 #endif



More information about the Rcpp-commits mailing list