[Rcpp-commits] r4057 - in pkg/Rcpp: . inst inst/include inst/include/Rcpp inst/include/Rcpp/internal inst/include/Rcpp/sugar/functions inst/include/Rcpp/traits inst/include/Rcpp/vector inst/unitTests inst/unitTests/cpp src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Dec 3 11:06:18 CET 2012
Author: romain
Date: 2012-12-03 11:06:18 +0100 (Mon, 03 Dec 2012)
New Revision: 4057
Added:
pkg/Rcpp/inst/include/Rcpp/String.h
pkg/Rcpp/inst/unitTests/cpp/String.cpp
pkg/Rcpp/inst/unitTests/runit.String.R
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/NEWS.Rd
pkg/Rcpp/inst/include/Rcpp/Vector.h
pkg/Rcpp/inst/include/Rcpp/as.h
pkg/Rcpp/inst/include/Rcpp/internal/r_coerce.h
pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h
pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h
pkg/Rcpp/inst/include/Rcpp/traits/wrap_type_traits.h
pkg/Rcpp/inst/include/Rcpp/vector/Vector.h
pkg/Rcpp/inst/include/Rcpp/vector/converter.h
pkg/Rcpp/inst/include/Rcpp/vector/string_proxy.h
pkg/Rcpp/inst/include/RcppCommon.h
pkg/Rcpp/src/Module.cpp
pkg/Rcpp/src/coerce.cpp
Log:
Rcpp::String
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/ChangeLog 2012-12-03 10:06:18 UTC (rev 4057)
@@ -1,3 +1,22 @@
+2012-12-03 Romain Francois <romain at r-enthusiasts.com>
+
+ * src/Module.cpp: move BEGIN_RCPP/END_RCPP to Module__invoke
+ * src/coerce.cpp: added coerce_to_string implementations
+ * include/RcppCommon.h : nicer formatting for RCPP_DEBUG_*, now up to
+ RCPP_DEBUG_5
+ * include/Rcpp/vector/Vector.h: debugging
+ * include/Rcpp/String.h: The String class
+ * include/Rcpp/as.h: support for String
+ * include/Rcpp/vector/converter.h : support for String
+ * include/Rcpp/vector/string_proxy.h: support for String
+ * include/Rcpp/internal/wrap.h : support for String
+ * include/Rcpp/internal/r_coerce.h: support for String
+ * include/Rcpp/sugar/functions/sapply.h: debugging
+ * include/Rcpp/traits/wrap_type_traits.h: support for String
+ * include/Rcpp/traits/r_type_traits.h: support for String
+ * unitTests/cpp/String.cpp : unit tests for String
+ * unitTests/runit.String.R: unit test for String
+
2012-12-01 Dirk Eddelbuettel <edd at debian.org>
* inst/include/RcppCommon.h: Applied patch by Yan Zhou to add support
Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/NEWS.Rd 2012-12-03 10:06:18 UTC (rev 4057)
@@ -9,7 +9,9 @@
\item Added additional check in \code{Rstreambuf} deletetion
\item Added support for \code{clang++} when using \code{libc++},
and for anc \code{icpc} in \code{std=c++11} mode, thanks to a
- patch by Yan Zhou
+ patch by Yan Zhou
+ \item New class \code{Rcpp::String} to facilitate working with a single
+ element of a character vector
}
}
}
Added: pkg/Rcpp/inst/include/Rcpp/String.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/String.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/String.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -0,0 +1,308 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// String.h: Rcpp R/C++ interface class library -- single string
+//
+// Copyright (C) 2012 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__String_h
+#define Rcpp__String_h
+
+#ifndef RCPP_STRING_DEBUG_LEVEL
+#define RCPP_STRING_DEBUG_LEVEL 0
+#endif
+
+
+#if RCPP_STRING_DEBUG_LEVEL > 0
+ #define RCPP_STRING_DEBUG_FORMAT "%40s:%4d "
+ #define RCPP_STRING_DEBUG( MSG ) Rprintf( RCPP_STRING_DEBUG_FORMAT "%s\n" , short_file_name(__FILE__), __LINE__, MSG ) ;
+ #define RCPP_STRING_DEBUG_1( fmt, MSG ) Rprintf( RCPP_STRING_DEBUG_FORMAT fmt "\n" , short_file_name(__FILE__), __LINE__, MSG ) ;
+ #define RCPP_STRING_DEBUG_2( fmt, M1, M2 ) Rprintf( RCPP_STRING_DEBUG_FORMAT fmt "\n" , short_file_name(__FILE__), __LINE__, M1, M2 ) ;
+ #define RCPP_STRING_DEBUG_3( fmt, M1, M2, M3 ) Rprintf( RCPP_STRING_DEBUG_FORMAT fmt "\n" , short_file_name(__FILE__), __LINE__, M1, M2, M3) ;
+#else
+ #define RCPP_STRING_DEBUG( MSG )
+ #define RCPP_STRING_DEBUG_1( fmt, MSG )
+ #define RCPP_STRING_DEBUG_2( fmt, M1, M2 )
+ #define RCPP_STRING_DEBUG_3( fmt, M1, M2, M3 )
+#endif
+
+
+namespace Rcpp {
+
+ /**
+ * A single string, i.e. an element of a character vector.
+ * This represents CHARSXP SEXP
+ */
+ class String {
+ public:
+ typedef internal::string_proxy<STRSXP> StringProxy;
+
+ /** default constructor */
+ String( ): data( Rf_mkChar("") ), buffer(), valid(true), buffer_ready(true) {
+ RCPP_STRING_DEBUG( "String()" ) ;
+ }
+
+ /** copy constructor */
+ String( const String& other) : data( other.get_sexp()), valid(true), buffer_ready(false) {
+ RCPP_STRING_DEBUG( "String(const String&)" ) ;
+ }
+
+ /** construct a string from a single CHARSXP SEXP */
+ String(SEXP charsxp) : data(charsxp), valid(true), buffer_ready(false) {
+ RCPP_STRING_DEBUG( "String(SEXP)" ) ;
+ }
+
+ /** from string proxy */
+ String( const StringProxy& proxy ): data( proxy.get() ), valid(true), buffer_ready(false){
+ RCPP_STRING_DEBUG( "String( const StringProxy&)" ) ;
+ }
+
+ /** from a std::string */
+ String( const std::string& s) : buffer(s), valid(false), buffer_ready(true) {
+ RCPP_STRING_DEBUG( "String(const std::string& )" ) ;
+ }
+
+ /** from a const char* */
+ String( const char* s) : buffer(s), valid(false), buffer_ready(true){
+ RCPP_STRING_DEBUG( "String(const char*)" ) ;
+ }
+
+ /** constructors from R primitives */
+ String( int x ) : data( internal::r_coerce<INTSXP,STRSXP>(x) ), valid(true), buffer_ready(false) {}
+ String( double x ) : data( internal::r_coerce<REALSXP,STRSXP>(x) ), valid(true), buffer_ready(false){}
+ String( bool x ) : data( internal::r_coerce<LGLSXP,STRSXP>(x) ), valid( true ) , buffer_ready(false){}
+ String( Rcomplex x ) : data( internal::r_coerce<CPLXSXP,STRSXP>(x) ), valid( true ), buffer_ready(false){}
+ String( Rbyte x ) : data( internal::r_coerce<RAWSXP,STRSXP>(x) ), valid(true), buffer_ready(false){}
+
+
+ inline String& operator=( int x ){ data = internal::r_coerce<INTSXP ,STRSXP>( x ) ; valid = true ; buffer_ready = false ; return *this ; }
+ inline String& operator=( double x ){ data = internal::r_coerce<REALSXP,STRSXP>( x ) ; valid = true ; buffer_ready = false ; return *this ; }
+ inline String& operator=( Rbyte x ){ data = internal::r_coerce<RAWSXP ,STRSXP>( x ) ; valid = true ; buffer_ready = false ; return *this ; }
+ inline String& operator=( bool x ){ data = internal::r_coerce<LGLSXP ,STRSXP>( x ) ; valid = true ; buffer_ready = false ; return *this ; }
+ inline String& operator=( Rcomplex x){ data = internal::r_coerce<CPLXSXP,STRSXP>( x ) ; valid = true ; buffer_ready = false ; return *this ; }
+ inline String& operator=( SEXP x){ data = x ; valid = true ; buffer_ready = false ; return *this ; }
+ inline String& operator=( const std::string& s){ buffer = s ; valid = false ; buffer_ready = true ; return *this ; }
+ inline String& operator=( const char* s){ buffer = s ; valid = false ; buffer_ready = true ; return *this ; }
+ inline String& operator=( const StringProxy& proxy){ data = proxy.get() ; valid = true ; buffer_ready=false ; return *this ; }
+ inline String& operator=( const String& other ){ data = other.data ; valid = true ; buffer_ready = false ; return *this ; }
+
+ inline String& operator+=( const std::string& s){
+ RCPP_STRING_DEBUG( "String::operator+=( std::string )" ) ;
+ if( is_na() ) return *this ;
+ setBuffer() ; buffer += s ; valid = false ;
+ return *this ;
+ }
+ inline String& operator+=( const char* s){
+ RCPP_STRING_DEBUG( "String::operator+=( const char*)" ) ;
+ if( is_na() ) return *this ;
+ setBuffer() ; buffer += s ; valid = false ;
+ return *this ;
+ }
+ inline String& operator+=( const String& other ){
+ RCPP_STRING_DEBUG( "String::operator+=( const char*)" ) ;
+ if( is_na() ) return *this ;
+ if( other.is_na() ){ data = NA_STRING ; valid = true ; buffer_ready = false ; return *this ; }
+ setBuffer() ; buffer += other ; valid = false ;
+ return *this ;
+ }
+
+ // inline String& operator+=( int x ){ data += char_nocheck(internal::r_coerce<INTSXP ,STRSXP>( x ) ) ; return *this ; }
+ // inline String& operator+=( double x ){ data += char_nocheck(internal::r_coerce<REALSXP,STRSXP>( x ) ) ; return *this ; }
+ // inline String& operator+=( Rbyte x ){ data += char_nocheck(internal::r_coerce<RAWSXP ,STRSXP>( x ) ) ; return *this ; }
+ // inline String& operator+=( bool x ){ data += char_nocheck(internal::r_coerce<LGLSXP ,STRSXP>( x ) ) ; return *this ; }
+ // inline String& operator+=( Rcomplex x){ data += char_nocheck(internal::r_coerce<CPLXSXP,STRSXP>( x ) ) ; return *this ; }
+ // inline String& operator+=( SEXP x){ data += CHAR(x) ; return *this ; }
+ // inline String& operator+=( const StringProxy& proxy){ data += CHAR(proxy.get()) ; return *this ; }
+
+
+ inline String& replace_first( const char* s, const char* news ){
+ RCPP_STRING_DEBUG_2( "String::replace_first( const char* = '%s' , const char* = '%s')", s, news ) ;
+ if( is_na() ) return *this ;
+ setBuffer() ;
+ size_t index = buffer.find_first_of( s ) ;
+ if( index != std::string::npos ) buffer.replace( index, strlen(s), news ) ;
+ valid = false ;
+ return *this ;
+ }
+ inline String& replace_first( const Rcpp::String& s, const char* news ){
+ // replace NA -> do nothing
+ if( s.is_na() ) return *this ;
+ return replace_first( s.get_cstring(), news ) ;
+ }
+ inline String& replace_first( const char* s, const Rcpp::String& news ){
+ // replace NA -> do nothing
+ if( news.is_na() ) return *this ;
+ return replace_first( s, news.get_cstring() ) ;
+ }
+ inline String& replace_first( const Rcpp::String& s, const Rcpp::String& news ){
+ // replace NA -> do nothing
+ if( s.is_na() || news.is_na() ) return *this ;
+ return replace_first( s.get_cstring(), news.get_cstring() ) ;
+ }
+
+
+
+ inline String& replace_last( const char* s, const char* news ){
+ RCPP_STRING_DEBUG_2( "String::replace_last( const char* = '%s' , const char* = '%s')", s, news ) ;
+ if( is_na() ) return *this ;
+ setBuffer() ;
+ size_t index = buffer.find_last_of( s ) ;
+ if( index != std::string::npos ) buffer.replace( index, strlen(s), news ) ;
+ valid = false ;
+ return *this ;
+ }
+ inline String& replace_last( const Rcpp::String& s, const char* news ){
+ // replace NA -> do nothing
+ if( s.is_na() ) return *this ;
+ return replace_last( s.get_cstring(), news ) ;
+ }
+ inline String& replace_last( const char* s, const Rcpp::String& news ){
+ // replace NA -> do nothing
+ if( news.is_na() ) return *this ;
+ return replace_last( s, news.get_cstring() ) ;
+ }
+ inline String& replace_last( const Rcpp::String& s, const Rcpp::String& news ){
+ // replace NA -> do nothing
+ if( s.is_na() || news.is_na() ) return *this ;
+ return replace_last( s.get_cstring(), news.get_cstring() ) ;
+ }
+
+
+ inline String& replace_all( const char* s, const char* news ){
+ RCPP_STRING_DEBUG_2( "String::replace_all( const char* = '%s' , const char* = '%s')", s, news ) ;
+ if( is_na() ) return *this ;
+ setBuffer() ;
+ size_t lens = strlen(s), len_news = strlen(news), index = buffer.find( s ) ;
+ while( index != std::string::npos ){
+ buffer.replace( index, lens, news ) ;
+ index = buffer.find( s, index + len_news ) ;
+ }
+ valid = false ;
+ return *this ;
+ }
+ inline String& replace_all( const Rcpp::String& s, const char* news ){
+ // replace NA -> do nothing
+ if( s.is_na() ) return *this ;
+ return replace_all( s.get_cstring(), news ) ;
+ }
+ inline String& replace_all( const char* s, const Rcpp::String& news ){
+ // replace NA -> do nothing
+ if( news.is_na() ) return *this ;
+ return replace_all( s, news.get_cstring() ) ;
+ }
+ inline String& replace_all( const Rcpp::String& s, const Rcpp::String& news ){
+ // replace NA -> do nothing
+ if( s.is_na() || news.is_na() ) return *this ;
+ return replace_all( s.get_cstring(), news.get_cstring() ) ;
+ }
+
+
+
+ inline SEXP get_sexp() const {
+ RCPP_STRING_DEBUG_1( "String::get_sexp const ( valid = %d) ", valid ) ;
+ return valid ? data : Rf_mkChar( buffer.c_str() ) ;
+ }
+
+ inline SEXP get_sexp() {
+ RCPP_STRING_DEBUG_1( "String::get_sexp ( valid = %d) ", valid ) ;
+ setData() ; return data ;
+ }
+
+ inline operator std::string() const {
+ return get_cstring() ;
+ }
+
+ inline const char* get_cstring() const {
+ return buffer_ready ? buffer.c_str() : CHAR(data) ;
+ }
+
+ bool operator<( const Rcpp::String& other ){
+ return strcmp( get_cstring(), other.get_cstring() ) < 0;
+ }
+
+ bool operator==( const Rcpp::String& other){
+ return get_sexp() == other.get_sexp() ;
+ }
+
+ bool operator>( const Rcpp::String& other ){
+ return strcmp( get_cstring(), other.get_cstring() ) > 0;
+ }
+
+ private:
+
+ /** the CHARSXP this String encapsulates */
+ SEXP data ;
+
+ /** a buffer used to do string operations withough going back to the SEXP */
+ std::string buffer ;
+
+ /** is data in sync with buffer */
+ bool valid ;
+
+ /** is the buffer initialized */
+ bool buffer_ready ;
+
+ inline bool is_na() const { return data == NA_STRING ; }
+ inline void setBuffer(){
+ if( !buffer_ready){
+ buffer = char_nocheck(data) ;
+ buffer_ready = true ;
+ }
+ }
+ inline void setData(){
+ RCPP_STRING_DEBUG( "setData" ) ;
+ if(!valid) {
+ data = Rf_mkChar(buffer.c_str()) ;
+ valid = true ;
+ }
+ }
+ template <typename T> void append( const T& s){ buffer += s ;}
+ } ;
+
+ namespace traits{
+ template<> struct r_type_traits<Rcpp::String>{ typedef r_type_RcppString_tag r_category ; } ;
+ template<> struct r_sexptype_traits<Rcpp::String>{ enum{ rtype = STRSXP } ; } ;
+ }
+
+ namespace internal {
+ template <int RTYPE>
+ string_proxy<RTYPE>& string_proxy<RTYPE>::operator=( const String& s){
+ set( s.get_sexp() );
+ return *this ;
+ }
+
+ template <int RTYPE>
+ SEXP string_element_converter<RTYPE>::get( const Rcpp::String& input) {
+ RCPP_DEBUG( "string_element_converter::get< Rcpp::String >()" )
+ return input.get_sexp() ;
+ }
+
+ }
+
+ template <>
+ inline SEXP wrap<Rcpp::String>( const Rcpp::String& object) {
+ RCPP_STRING_DEBUG( "wrap<String>()" ) ;
+ SEXP res = PROTECT( Rf_allocVector( STRSXP, 1 ) ) ;
+ SEXP data = object.get_sexp();
+ SET_STRING_ELT( res, 0, data ) ;
+ UNPROTECT(1) ;
+ return res ;
+ }
+
+} // Rcpp
+
+#endif
Modified: pkg/Rcpp/inst/include/Rcpp/Vector.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Vector.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/Vector.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -62,7 +62,11 @@
#include <Rcpp/vector/instantiation.h>
#include <Rcpp/vector/string_proxy.h>
+}
+#include <Rcpp/String.h>
+
+namespace Rcpp{
#include <Rcpp/vector/LazyVector.h>
#include <Rcpp/vector/CharacterVectorExtractionIterator.h>
Modified: pkg/Rcpp/inst/include/Rcpp/as.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/as.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/as.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -50,6 +50,16 @@
return T( CHAR( STRING_ELT( ::Rcpp::r_cast<STRSXP>(x) ,0 ) ) ) ;
}
+ template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_RcppString_tag ) {
+ if( ! ::Rf_isString(x) ){
+ throw ::Rcpp::not_compatible( "expecting a string" ) ;
+ }
+ if (Rf_length(x) != 1) {
+ throw ::Rcpp::not_compatible( "expecting a single value");
+ }
+ return STRING_ELT( ::Rcpp::r_cast<STRSXP>(x) ,0 ) ;
+ }
+
template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_generic_tag ) {
RCPP_DEBUG_1( "as(SEXP = <%p>, r_type_generic_tag )", x ) ;
::Rcpp::traits::Exporter<T> exporter(x);
Modified: pkg/Rcpp/inst/include/Rcpp/internal/r_coerce.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/r_coerce.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/internal/r_coerce.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -69,15 +69,21 @@
template <> Rcomplex r_coerce<LGLSXP,CPLXSXP>(int from) ;
// -> STRSXP
+template <int RTYPE>
+const char* coerce_to_string( typename ::Rcpp::traits::storage_type<RTYPE>::type from ) ;
+template <> const char* coerce_to_string<CPLXSXP>(Rcomplex from) ;
+template <> const char* coerce_to_string<REALSXP>(double from) ;
+template <> const char* coerce_to_string<INTSXP >(int from) ;
+template <> const char* coerce_to_string<RAWSXP >(Rbyte from) ;
+template <> const char* coerce_to_string<LGLSXP >(int from) ;
+
template <> inline SEXP r_coerce<STRSXP ,STRSXP>(SEXP from){ return from ; }
-template <> SEXP r_coerce<CPLXSXP,STRSXP>(Rcomplex from) ;
-template <> SEXP r_coerce<REALSXP,STRSXP>(double from) ;
-template <> SEXP r_coerce<INTSXP ,STRSXP>(int from);
-template <> SEXP r_coerce<RAWSXP ,STRSXP>(Rbyte from);
-template <> SEXP r_coerce<LGLSXP ,STRSXP>(int from) ;
+template <> inline SEXP r_coerce<CPLXSXP,STRSXP>(Rcomplex from) { return Rcpp::traits::is_na<CPLXSXP>(from) ? NA_STRING : Rf_mkChar( coerce_to_string<CPLXSXP>( from ) ) ; }
+template <> inline SEXP r_coerce<REALSXP,STRSXP>(double from){ return Rcpp::traits::is_na<REALSXP>(from) ? NA_STRING :Rf_mkChar( coerce_to_string<REALSXP>( from ) ) ; }
+template <> inline SEXP r_coerce<INTSXP ,STRSXP>(int from){ return Rcpp::traits::is_na<INTSXP>(from) ? NA_STRING :Rf_mkChar( coerce_to_string<INTSXP>( from ) ) ; }
+template <> inline SEXP r_coerce<RAWSXP ,STRSXP>(Rbyte from){ return Rf_mkChar( coerce_to_string<RAWSXP>(from)); }
+template <> inline SEXP r_coerce<LGLSXP ,STRSXP>(int from){ return Rcpp::traits::is_na<LGLSXP>(from) ? NA_STRING :Rf_mkChar( coerce_to_string<LGLSXP>(from)); }
-
-
} // internal
} // Rcpp
Modified: pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/wrap.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/internal/wrap.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -387,6 +387,7 @@
return x;
}
+
/**
* called when T is a primitive type : int, bool, double, std::string, etc ...
* This uses the Rcpp::traits::r_type_traits on the type T to perform
@@ -806,6 +807,8 @@
return internal::wrap_dispatch( object, typename ::Rcpp::traits::wrap_type_traits<T>::wrap_category() ) ;
}
+template <> inline SEXP wrap<Rcpp::String>( const Rcpp::String& object) ;
+
template <typename T>
inline SEXP module_wrap_dispatch( const T& obj, Rcpp::traits::void_wrap_tag ){
return R_NilValue ;
Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/sapply.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -44,10 +44,14 @@
typedef typename Rcpp::traits::Extractor< RTYPE, NA, T>::type EXT ;
- Sapply( const VEC& vec_, Function fun_ ) : vec(vec_.get_ref()), fun(fun_){}
+ Sapply( const VEC& vec_, Function fun_ ) : vec(vec_.get_ref()), fun(fun_){
+ RCPP_DEBUG_1( "Sapply With Converter = %s", DEMANGLE(Sapply) )
+ RCPP_DEBUG_1( "Sapply Converter = %s", DEMANGLE(converter_type) )
+ }
inline STORAGE operator[]( int i ) const {
- return converter_type::get( fun( vec[i] ) );
+ STORAGE res = converter_type::get( fun( vec[i] ) );
+ return res ;
}
inline int size() const { return vec.size() ; }
@@ -76,7 +80,9 @@
typedef typename Rcpp::traits::Extractor< RTYPE, NA, T>::type EXT ;
- Sapply( const VEC& vec_, Function fun_ ) : vec(vec_.get_ref()), fun(fun_){}
+ Sapply( const VEC& vec_, Function fun_ ) : vec(vec_.get_ref()), fun(fun_){
+ RCPP_DEBUG_1( "Sapply = %s", DEMANGLE(Sapply) )
+ }
inline STORAGE operator[]( int i ) const {
return fun( vec[i] ) ;
Modified: pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -75,6 +75,8 @@
*/
struct r_type_enum_tag{} ;
+struct r_type_RcppString_tag{};
+
/**
* R type trait. Helps wrap.
*/
Modified: pkg/Rcpp/inst/include/Rcpp/traits/wrap_type_traits.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/wrap_type_traits.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/traits/wrap_type_traits.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -74,6 +74,7 @@
template <> struct wrap_type_traits<unsigned int> { typedef wrap_type_primitive_tag wrap_category; } ;
template <> struct wrap_type_traits<bool> { typedef wrap_type_primitive_tag wrap_category; } ;
template <> struct wrap_type_traits<std::string> { typedef wrap_type_primitive_tag wrap_category; } ;
+template <> struct wrap_type_traits<Rcpp::String> { typedef wrap_type_primitive_tag wrap_category; } ;
template <> struct wrap_type_traits<char> { typedef wrap_type_primitive_tag wrap_category; } ;
template <> struct wrap_type_traits<float> { typedef wrap_type_primitive_tag wrap_category; } ;
Modified: pkg/Rcpp/inst/include/Rcpp/vector/Vector.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/Vector.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/vector/Vector.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -134,6 +134,7 @@
template <bool NA, typename VEC>
Vector( const VectorBase<RTYPE,NA,VEC>& other ) : RObject() {
+ RCPP_DEBUG_4( "Vector<%d>( VectorBase<%d,%d,%s> )", RTYPE, NA, RTYPE, DEMANGLE(VEC) ) ;
int n = other.size() ;
RObject::setSEXP( Rf_allocVector( RTYPE, n ) ) ;
import_expression<VEC>( other.get_ref() , n ) ;
Modified: pkg/Rcpp/inst/include/Rcpp/vector/converter.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/converter.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/vector/converter.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -46,19 +46,27 @@
template <typename T>
static SEXP get( const T& input){
std::string out(input) ;
+ RCPP_DEBUG_1( "string_element_converter::get< T = %s >()", DEMANGLE(T) )
return Rf_mkChar( out.c_str() ) ;
}
static SEXP get(const std::string& input){
+ RCPP_DEBUG( "string_element_converter::get< std::string >()" )
return Rf_mkChar( input.c_str() ) ;
}
+ static SEXP get( const Rcpp::String& input) ;
+
static SEXP get(const char& input){
+ RCPP_DEBUG( "string_element_converter::get< char >()" )
return Rf_mkChar( &input ) ;
}
// assuming a CHARSXP
- static SEXP get(SEXP x){ return x; }
+ static SEXP get(SEXP x){
+ RCPP_DEBUG( "string_element_converter::get< SEXP >()" )
+ return x;
+ }
} ;
template <int RTYPE>
Modified: pkg/Rcpp/inst/include/Rcpp/vector/string_proxy.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/string_proxy.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/Rcpp/vector/string_proxy.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -59,6 +59,8 @@
return *this ;
}
+ string_proxy& operator=( const String& s) ;
+
/**
* lhs use. Assigns the value of the referred element
* of the character vector
Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/inst/include/RcppCommon.h 2012-12-03 10:06:18 UTC (rev 4057)
@@ -270,7 +270,9 @@
} // namespace Rcpp
// simple logging help
+#ifndef RCPP_DEBUG_LEVEL
#define RCPP_DEBUG_LEVEL 0
+#endif
#ifndef logTxt
#if RCPP_DEBUG_LEVEL > 0
@@ -280,16 +282,27 @@
#endif
#endif
+inline const char* short_file_name(const char* file){
+ std::string f(file) ;
+ size_t index = f.find("/include/") ;
+ if( index != std::string::npos ){ f = f.substr( index + 9 ) ;}
+ return f.c_str() ;
+}
+
#if RCPP_DEBUG_LEVEL > 0
- #define RCPP_DEBUG( MSG ) Rprintf( "%s:%d %s\n" , __FILE__, __LINE__, MSG ) ;
- #define RCPP_DEBUG_1( fmt, MSG ) Rprintf( "%s:%d " fmt "\n" , __FILE__, __LINE__, MSG ) ;
- #define RCPP_DEBUG_2( fmt, M1, M2 ) Rprintf( "%s:%d" fmt "\n" , __FILE__, __LINE__, M1, M2 ) ;
- #define RCPP_DEBUG_3( fmt, M1, M2, M3 ) Rprintf( "%s:%d" fmt "\n" , __FILE__, __LINE__, M1, M2, M3) ;
+ #define RCPP_DEBUG( MSG ) Rprintf( "%40s:%4d %s\n" , short_file_name(__FILE__), __LINE__, MSG ) ;
+ #define RCPP_DEBUG_1( fmt, MSG ) Rprintf( "%40s:%4d " fmt "\n" , short_file_name(__FILE__), __LINE__, MSG ) ;
+ #define RCPP_DEBUG_2( fmt, M1, M2 ) Rprintf( "%40s:%4d " fmt "\n" , short_file_name(__FILE__), __LINE__, M1, M2 ) ;
+ #define RCPP_DEBUG_3( fmt, M1, M2, M3 ) Rprintf( "%40s:%4d " fmt "\n" , short_file_name(__FILE__), __LINE__, M1, M2, M3) ;
+ #define RCPP_DEBUG_4( fmt, M1, M2, M3, M4 ) Rprintf( "%40s:%4d " fmt "\n" , short_file_name(__FILE__), __LINE__, M1, M2, M3, M4) ;
+ #define RCPP_DEBUG_5( fmt, M1, M2, M3, M4, M5 ) Rprintf( "%40s:%4d " fmt "\n" , short_file_name(__FILE__), __LINE__, M1, M2, M3, M4, M5) ;
#else
#define RCPP_DEBUG( MSG )
#define RCPP_DEBUG_1( fmt, MSG )
#define RCPP_DEBUG_2( fmt, M1, M2 )
#define RCPP_DEBUG_3( fmt, M1, M2, M3 )
+ #define RCPP_DEBUG_4( fmt, M1, M2, M3, M4 )
+ #define RCPP_DEBUG_5( fmt, M1, M2, M3, M4, M5 )
#endif
SEXP stack_trace( const char *file, int line) ;
@@ -316,6 +329,7 @@
namespace Rcpp{
template <typename T> class object ;
+ class String ;
namespace internal{
template <typename Class> SEXP make_new_object( Class* ptr ) ;
}
Added: pkg/Rcpp/inst/unitTests/cpp/String.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/String.cpp (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/String.cpp 2012-12-03 10:06:18 UTC (rev 4057)
@@ -0,0 +1,61 @@
+// #define RCPP_STRING_DEBUG_LEVEL 0
+// #define RCPP_DEBUG_LEVEL 0
+#include <Rcpp.h>
+using namespace Rcpp ;
+
+
+// [[Rcpp::export]]
+String String_replace_all( String z, String x, String y){
+ z.replace_all( x, y ) ;
+ return z ;
+}
+
+// [[Rcpp::export]]
+String String_replace_first( String z, String x, String y){
+ z.replace_first( x, y ) ;
+ return z ;
+}
+// [[Rcpp::export]]
+String String_replace_last( String z, String x, String y){
+ z.replace_last( x, y ) ;
+ return z ;
+}
+
+class StringConv{
+public:
+ typedef String result_type ;
+ StringConv( CharacterVector old_, CharacterVector new__):
+ nr(old_.size()), old(old_), new_(new__)
+ {
+ }
+
+ String operator()(String text) const {
+ for( int i=0; i<nr; i++){
+ text.replace_all( old[i], new_[i] ) ;
+ }
+ return text ;
+ }
+
+private:
+ int nr ;
+ CharacterVector old ;
+ CharacterVector new_ ;
+} ;
+
+// [[Rcpp::export]]
+CharacterVector test_sapply_string( CharacterVector text, CharacterVector old , CharacterVector new_){
+ CharacterVector res = sapply( text, StringConv( old, new_ ) ) ;
+ return res ;
+}
+
+// [[Rcpp::export]]
+List test_compare_Strings( String a, String b ){
+ return List::create(
+ _["a < b" ] = a < b,
+ _["a > b" ] = a > b,
+ _["a == b"] = a == b,
+ _["a == a"] = a == a
+
+ ) ;
+}
+
Added: pkg/Rcpp/inst/unitTests/runit.String.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.String.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.String.R 2012-12-03 10:06:18 UTC (rev 4057)
@@ -0,0 +1,56 @@
+#!/usr/bin/r -t
+# -*- mode: R; tab-width: 4; -*-
+#
+# Copyright (C) 2012 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/>.
+
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
+.setUp <- function(){
+ #sourceCpp( system.file( "unitTests/cpp/String.cpp" , package = "Rcpp" ) )
+ sourceCpp(file.path(pathRcppTests, "cpp/String.cpp"))
+}
+
+test.replace_all <- function(){
+ checkEquals( String_replace_all("foobar", "o", "*"), "f**bar")
+}
+test.replace_first <- function(){
+ checkEquals( String_replace_first("foobar", "o", "*"), "f*obar")
+}
+test.replace_last <- function(){
+ checkEquals( String_replace_last("foobar", "o", "*"), "fo*bar")
+}
+
+test.String.sapply <- function(){
+ res <- test_sapply_string( "foobar", c("o", "a" ), c("*", "!" ) )
+ checkEquals( res, "f**b!r" )
+}
+
+test.compare.Strings <- function(){
+ res <- test_compare_Strings( "aaa", "aab" )
+ target <- list(
+ "a < b" = TRUE,
+ "a > b" = FALSE,
+ "a == b" = FALSE,
+ "a == a" = TRUE
+ )
+ checkEquals( res, target )
+}
+
+}
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2012-12-03 05:48:07 UTC (rev 4056)
+++ pkg/Rcpp/src/Module.cpp 2012-12-03 10:06:18 UTC (rev 4057)
@@ -130,6 +130,7 @@
}
extern "C" SEXP Module__invoke( SEXP args){
+BEGIN_RCPP
SEXP p = CDR(args) ;
XP_Module module( CAR(p) ) ; p = CDR(p) ;
std::string fun = Rcpp::as<std::string>( CAR(p) ) ; p = CDR(p) ;
@@ -142,6 +143,7 @@
p = CDR(p) ;
}
return module->invoke( fun, cargs, nargs ) ;
+END_RCPP
}
extern "C" SEXP class__newInstance(SEXP args){
@@ -277,21 +279,19 @@
}
SEXP Module::invoke( const std::string& name_, SEXP* args, int nargs){
- BEGIN_RCPP
- MAP::iterator it = functions.find( name_ );
- if( it == functions.end() ){
- throw std::range_error( "no such function" ) ;
- }
- CppFunction* fun = it->second ;
- if( fun->nargs() > nargs ){
- throw std::range_error( "incorrect number of arguments" ) ;
- }
-
- return Rcpp::List::create(
- Rcpp::Named("result") = fun->operator()( args ),
- Rcpp::Named("void") = fun->is_void()
- ) ;
- END_RCPP
+ MAP::iterator it = functions.find( name_ );
+ if( it == functions.end() ){
+ throw std::range_error( "no such function" ) ;
+ }
+ CppFunction* fun = it->second ;
+ if( fun->nargs() > nargs ){
+ throw std::range_error( "incorrect number of arguments" ) ;
+ }
+
+ return Rcpp::List::create(
+ Rcpp::Named("result") = fun->operator()( args ),
+ Rcpp::Named("void") = fun->is_void()
+ ) ;
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 4057
More information about the Rcpp-commits
mailing list