[Rcpp-devel] [Rcpp-commits] r294 - 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 13:26:02 CET 2010


Author: romain
Date: 2010-01-07 13:26:02 +0100 (Thu, 07 Jan 2010)
New Revision: 294

Added:
   pkg/inst/unitTests/runit.CharacterVector.R
   pkg/src/CharacterVector.cpp
   pkg/src/Rcpp/CharacterVector.h
Modified:
   pkg/inst/ChangeLog
   pkg/src/GenericVector.cpp
   pkg/src/Rcpp.h
   pkg/src/Rcpp/GenericVector.h
Log:
+ Rcpp::CharacterVector

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-07 09:23:37 UTC (rev 293)
+++ pkg/inst/ChangeLog	2010-01-07 12:26:02 UTC (rev 294)
@@ -1,5 +1,10 @@
 2010-01-07  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/CharacterVector.h: new class Rcpp::CharacterVector
+	to manage character vectors (STRSXP)
+	* src/CharacterVector.cpp: implementation
+	* inst/unitTests/runit.CharacterVector.R: unit tests
+
 	* src/Rcpp/WeakReference.h: new class Rcpp::WeakReference
 	to wrap WEAKREFSXP with accessors to the key and value
 	* src/WeakReference.cpp: implementation

Added: pkg/inst/unitTests/runit.CharacterVector.R
===================================================================
--- pkg/inst/unitTests/runit.CharacterVector.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.CharacterVector.R	2010-01-07 12:26:02 UTC (rev 294)
@@ -0,0 +1,56 @@
+#!/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.CharacterVector <- function(){
+	funx <- cfunction(signature(), '
+	CharacterVector x(10) ;
+	for( int i=0; i<10; i++) x[i] = "foo" ;
+	return x ;', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), rep("foo",10L), msg = "CharacterVector" )
+}
+
+test.CharacterVector.STRSXP <- function(){
+	funx <- cfunction(signature(vec = "character" ), '
+	CharacterVector x(vec) ;
+	std::string st = "" ; 
+	for( int i=0; i<x.size(); i++) { 
+		st += x[i] ;
+	}
+	return wrap( st ) ;', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(letters), paste(letters,collapse="" ), 
+		msg = "CharacterVector( STRSXP) " )
+}
+
+test.CharacterVector.initializer.list <- function(){
+	if( Rcpp:::capabilities()[["initializer lists"]] ){
+		funx <- cfunction(signature(), '
+		CharacterVector x = {"foo", "bar"} ;
+		return x ;', 
+			Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+		checkEquals( funx(), c("foo","bar"), msg = "CharacterVector( initializer list) " )
+	}
+}
+
+

Added: pkg/src/CharacterVector.cpp
===================================================================
--- pkg/src/CharacterVector.cpp	                        (rev 0)
+++ pkg/src/CharacterVector.cpp	2010-01-07 12:26:02 UTC (rev 294)
@@ -0,0 +1,107 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// CharacterVector.cpp: Rcpp R/C++ interface class library -- character 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/CharacterVector.h>
+#include <algorithm>
+
+namespace Rcpp{
+	
+	CharacterVector::CharacterVector(SEXP x) throw(not_compatible) : RObject() {
+		switch( TYPEOF( x ) ){
+			case STRSXP:
+				setSEXP( x ) ;
+				break ;
+			case SYMSXP:
+				setSEXP( Rf_ScalarString(PRINTNAME(x)) ) ;
+				break ;
+			case CHARSXP:
+				setSEXP( Rf_ScalarString( x ) ) ;
+			default:
+				/* TODO: try coercion */
+				throw not_compatible( "not compatible with character vector" ) ;
+		}
+	}
+	
+	CharacterVector::CharacterVector(int size) : RObject() {
+		setSEXP( Rf_allocVector(STRSXP, size) ) ;
+	}
+
+#ifdef HAS_INIT_LISTS
+	CharacterVector::CharacterVector( std::initializer_list<std::string> list ) {
+		SEXP x = PROTECT( Rf_allocVector( STRSXP, list.size() ) ) ;
+		const std::string *p = list.begin() ;
+		int n = list.size() ;
+		for( int i=0; i<n ; i++, p++){
+			SET_STRING_ELT( x, i, Rf_mkChar(p->c_str()) ) ;
+		}
+		setSEXP( x ) ;
+		UNPROTECT( 1 ); /* x */
+	}
+#endif
+
+SEXP CharacterVector::get( const int& i ) const { 
+	return STRING_ELT(m_sexp, i) ;
+}
+
+void CharacterVector::set( const int& i, const std::string& value ){
+	SET_STRING_ELT(m_sexp,i, Rf_mkChar(value.c_str()) ) ;
+}
+
+SEXP* CharacterVector::begin(){
+	return RCPP_VECTOR_PTR(m_sexp) ;
+}
+
+SEXP* CharacterVector::end(){
+	return RCPP_VECTOR_PTR(m_sexp) + LENGTH(m_sexp) ;
+}
+
+CharacterVector::StringProxy::StringProxy(CharacterVector& v, int i) :
+	parent(v), index(i){}
+
+CharacterVector::StringProxy::operator SEXP() const{
+	return STRING_ELT( parent, index ) ;
+}
+
+CharacterVector::StringProxy::operator char*() const {
+	return const_cast<char*>( CHAR(STRING_ELT( parent, index )) );
+}
+
+CharacterVector::StringProxy& CharacterVector::StringProxy::operator=( const StringProxy& rhs){
+	SET_STRING_ELT( parent, index, STRING_ELT( rhs.parent, rhs.index) ) ;
+}
+
+CharacterVector::StringProxy& CharacterVector::StringProxy::operator=( const std::string& rhs){
+	SET_STRING_ELT( parent, index, Rf_mkChar( rhs.c_str() ) ) ;
+}
+
+const CharacterVector::StringProxy CharacterVector::operator[](int i) const {
+	return StringProxy(const_cast<CharacterVector&>(*this), i) ;
+}
+
+CharacterVector::StringProxy CharacterVector::operator[](int i) {
+	return StringProxy(*this, i ) ;
+}
+
+
+
+} // namespace 

Modified: pkg/src/GenericVector.cpp
===================================================================
--- pkg/src/GenericVector.cpp	2010-01-07 09:23:37 UTC (rev 293)
+++ pkg/src/GenericVector.cpp	2010-01-07 12:26:02 UTC (rev 294)
@@ -1,6 +1,6 @@
 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
 //
-// GenericVector.h: Rcpp R/C++ interface class library -- integer vectors
+// GenericVector.cpp: Rcpp R/C++ interface class library -- generic vectors (lists)
 //
 // Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
 //
@@ -68,4 +68,10 @@
 	return RCPP_VECTOR_PTR(m_sexp) + LENGTH(m_sexp) ;
 }
 
+/* does this work for = ? */
+SEXP& GenericVector::operator[](int i) const {
+	return *(RCPP_VECTOR_PTR(m_sexp) + i) ;
+}
+
+
 } // namespace 

Added: pkg/src/Rcpp/CharacterVector.h
===================================================================
--- pkg/src/Rcpp/CharacterVector.h	                        (rev 0)
+++ pkg/src/Rcpp/CharacterVector.h	2010-01-07 12:26:02 UTC (rev 294)
@@ -0,0 +1,89 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// CharacterVector.h: Rcpp R/C++ interface class library -- character 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_CharacterVector_h
+#define Rcpp_CharacterVector_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+
+#ifdef HAS_INIT_LISTS
+#include <initializer_list>
+#include <algorithm>
+#endif
+
+namespace Rcpp{ 
+
+class CharacterVector : public RObject {     
+public:
+
+	/* much inspired from item 30 of more effective C++ */
+	class StringProxy {
+	public:
+		StringProxy( CharacterVector& v, int index ) ;
+		
+		/* lvalue uses */
+		StringProxy& operator=(const StringProxy& rhs) ;
+		StringProxy& operator=(const std::string& rhs) ;
+		
+		/* rvalue use */
+		operator SEXP() const ;
+		operator char*() const ;
+		
+	private:
+		CharacterVector& parent; 
+		int index ;
+	} ;
+
+	
+	CharacterVector(SEXP x) throw(not_compatible);
+	CharacterVector(int size) ;
+	
+#ifdef HAS_INIT_LISTS
+	CharacterVector( std::initializer_list<std::string> 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 get(const int& i) const ;
+	void set(const int& i, const std::string& value ) ;
+	
+	SEXP* begin(); 
+	SEXP* end() ;
+	
+	const StringProxy operator[]( int i ) const ;
+	StringProxy operator[]( int i ) ;
+	
+	friend class StringProxy; 
+	
+} ;
+
+} // namespace
+
+#endif

Modified: pkg/src/Rcpp/GenericVector.h
===================================================================
--- pkg/src/Rcpp/GenericVector.h	2010-01-07 09:23:37 UTC (rev 293)
+++ pkg/src/Rcpp/GenericVector.h	2010-01-07 12:26:02 UTC (rev 294)
@@ -1,6 +1,6 @@
 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
 //
-// GenericVector.h: Rcpp R/C++ interface class library -- logical vectors
+// GenericVector.h: Rcpp R/C++ interface class library -- generic vectors (lists)
 //
 // Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
 //
@@ -58,6 +58,7 @@
 	SEXP* begin(); 
 	SEXP* end() ;
 	
+	SEXP& operator[]( int i ) const ;
 	
 } ;
 

Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h	2010-01-07 09:23:37 UTC (rev 293)
+++ pkg/src/Rcpp.h	2010-01-07 12:26:02 UTC (rev 294)
@@ -62,5 +62,6 @@
 #include <Rcpp/LogicalVector.h>
 #include <Rcpp/GenericVector.h>
 #include <Rcpp/WeakReference.h>
+#include <Rcpp/CharacterVector.h>
 
 #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


More information about the Rcpp-devel mailing list