[Rcpp-commits] r915 - in pkg/Rcpp: inst/unitTests src src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 19 10:55:50 CET 2010
Author: romain
Date: 2010-03-19 10:55:50 +0100 (Fri, 19 Mar 2010)
New Revision: 915
Added:
pkg/Rcpp/inst/unitTests/runit.Vector.create.R
Modified:
pkg/Rcpp/src/Rcpp.h
pkg/Rcpp/src/Rcpp/Named.h
pkg/Rcpp/src/Rcpp/Vector.h
Log:
initial (pre code bloat) Vector<>::create
Added: pkg/Rcpp/inst/unitTests/runit.Vector.create.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.create.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.create.R 2010-03-19 09:55:50 UTC (rev 915)
@@ -0,0 +1,63 @@
+#!/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.IntegerVector.create <- function(){
+ fx <- cfunction(signature(), '
+ List output(2);
+ output[0] = IntegerVector::create( 10 ) ;
+ output[1] = IntegerVector::create( _["foo"] = 20 ) ;
+ return output ;
+ ',
+ Rcpp = TRUE, includes = "using namespace Rcpp;" )
+
+ checkEquals( fx(), list( 10L, c(foo = 20L ) ),
+ msg = "IntegerVector::create" )
+}
+
+test.List.create <- function(){
+ fx <- cfunction(signature(), '
+ List output(2);
+ output[0] = List::create( 10 ) ;
+ output[1] = List::create( _["foo"] = "bar" ) ;
+ return output ;
+ ',
+ Rcpp = TRUE, includes = "using namespace Rcpp;" )
+
+ checkEquals( fx(), list( list( 10L ), list(foo = "bar" ) ),
+ msg = "List::create" )
+}
+
+test.CharacterVector.create <- function(){
+ fx <- cfunction(signature(), '
+ List output(2);
+ output[0] = CharacterVector::create( "foo" ) ;
+ output[1] = CharacterVector::create( _["foo"] = "bar" ) ;
+ return output ;
+ ',
+ Rcpp = TRUE, includes = "using namespace Rcpp;" )
+
+ checkEquals( fx(), list( "foo", c(foo = "bar" ) ),
+ msg = "CharacterVector::create" )
+
+}
+
Modified: pkg/Rcpp/src/Rcpp/Named.h
===================================================================
--- pkg/Rcpp/src/Rcpp/Named.h 2010-03-18 14:51:56 UTC (rev 914)
+++ pkg/Rcpp/src/Rcpp/Named.h 2010-03-19 09:55:50 UTC (rev 915)
@@ -72,14 +72,39 @@
std::string tag ;
} ;
+namespace traits {
+
+template <typename T> class named_object {
+ public:
+ named_object( const std::string& name_, const T& o_) :
+ name(name_), object(o_){}
+ const std::string& name ;
+ const T& object ;
+ operator ::Rcpp::Named(){
+ return ::Rcpp::Named(name, object) ;
+ }
+} ;
+
+template <typename T>
+named_object<T> named( const std::string& name, const T& o){
+ return named_object<T>( name, o );
+} ;
+
+template <typename T> struct is_named : public false_type{} ;
+template <typename T> struct is_named< named_object<T> > : public true_type {} ;
+
+
+} // namespace traits
+
+
class Argument {
public:
Argument() : name(){} ;
Argument( const std::string& name_) : name(name_){}
template<typename T>
- Named operator=( const T& t){
- return Named( name, t ) ;
+ traits::named_object<T> operator=( const T& t){
+ return traits::named_object<T>( name, t ) ;
}
private:
@@ -88,16 +113,16 @@
namespace internal{
-
+
class NamedPlaceHolder {
public:
NamedPlaceHolder(){}
~NamedPlaceHolder(){}
- Named operator[]( const std::string& arg) const {
- return Named( arg ) ;
+ Argument operator[]( const std::string& arg) const {
+ return Argument( arg ) ;
}
- Named operator()(const std::string& arg) const {
- return Named( arg ) ;
+ Argument operator()(const std::string& arg) const {
+ return Argument( arg ) ;
}
operator SEXP() const { return R_MissingArg ; }
} ;
Modified: pkg/Rcpp/src/Rcpp/Vector.h
===================================================================
--- pkg/Rcpp/src/Rcpp/Vector.h 2010-03-18 14:51:56 UTC (rev 914)
+++ pkg/Rcpp/src/Rcpp/Vector.h 2010-03-19 09:55:50 UTC (rev 915)
@@ -216,7 +216,8 @@
template <int RTYPE>
class string_element_converter {
public:
- // typedef typename ::Rcpp::traits::storage_typ
+ typedef SEXP target ;
+
string_element_converter(){};
template <typename T>
@@ -228,11 +229,16 @@
SEXP get(const std::string& input){
return Rf_mkChar( input.c_str() ) ;
}
+
+ SEXP get(const char& input){
+ return Rf_mkChar( &input ) ;
+ }
} ;
template <int RTYPE>
class generic_element_converter {
public:
+ typedef SEXP target ;
generic_element_converter(){};
template <typename T>
@@ -681,8 +687,60 @@
cache.update(*this) ;
}
+ template <typename T1>
+ static SEXP create( const T1& t1){
+ return create__dispatch( typename traits::integral_constant< bool, traits::is_named<T1>::value >::type(), t1 ) ;
+ }
+
private:
+ template <typename T1>
+ static SEXP create__dispatch( traits::false_type, const T1& t1 ){
+ Vector res(1) ;
+ iterator it( res.begin() );
+
+ ////
+ *it = converter.get(t1) ; ++it ;
+ ////
+
+ return res ;
+ }
+
+ template <typename T1>
+ static SEXP create__dispatch( traits::true_type, const T1& t1){
+ Vector res(1) ;
+ SEXP names = PROTECT( ::Rf_allocVector( STRSXP, 1 ) ) ;
+ int index = 0 ;
+ iterator it( res.begin() );
+
+ ////
+ replace_element( it, names, index, t1 ) ; ++it; ++index ;
+ ////
+
+ res.attr("names") = names ;
+ UNPROTECT(1); // names
+ return res ;
+ }
+
+ template <typename U>
+ static void replace_element( iterator it, SEXP names, int index, const U& u){
+ replace_element__dispatch( typename traits::is_named<U>::type(),
+ it, names, index, u ) ;
+ }
+
+ template <typename U>
+ static void replace_element__dispatch( traits::false_type, iterator it, SEXP names, int index, const U& u){
+ typedef typename converter_type::target target_type ;
+ target_type value = converter.get(u); *it = value ;
+ }
+
+ template <typename U>
+ static void replace_element__dispatch( traits::true_type, iterator it, SEXP names, int index, const U& u){
+ *it = converter.get(u.object ) ;
+ SET_STRING_ELT( names, index, ::Rf_mkChar( u.name.c_str() ) ) ;
+ }
+
+
void set_sexp(SEXP x){
Base::setSEXP( x) ;
update_vector() ;
@@ -1203,6 +1261,17 @@
return *this ;
}
+ string_proxy& operator=(const char& rhs){
+ set( Rf_mkChar( &rhs ) ) ;
+ return *this ;
+ }
+
+ string_proxy& operator=(SEXP rhs){
+ // TODO: check this is a CHARSXP
+ set( rhs ) ;
+ return *this ;
+ }
+
/**
* lhs use. Adds the content of the rhs proxy to the
* element this proxy refers to.
Modified: pkg/Rcpp/src/Rcpp.h
===================================================================
--- pkg/Rcpp/src/Rcpp.h 2010-03-18 14:51:56 UTC (rev 914)
+++ pkg/Rcpp/src/Rcpp.h 2010-03-19 09:55:50 UTC (rev 915)
@@ -48,6 +48,7 @@
/* new api */
#include <Rcpp/RObject.h>
+#include <Rcpp/Named.h>
#include <Rcpp/S4.h>
#include <Rcpp/exceptions.h>
@@ -60,7 +61,6 @@
#include <Rcpp/XPtr.h>
#include <Rcpp/Symbol.h>
#include <Rcpp/Language.h>
-#include <Rcpp/Named.h>
#include <Rcpp/make_list.h>
#include <Rcpp/DottedPair.h>
#include <Rcpp/Pairlist.h>
More information about the Rcpp-commits
mailing list