[Rcpp-commits] r1658 - in pkg/Rcpp/inst: include include/Rcpp include/Rcpp/internal include/Rcpp/traits unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jun 23 10:40:15 CEST 2010


Author: romain
Date: 2010-06-23 10:40:15 +0200 (Wed, 23 Jun 2010)
New Revision: 1658

Added:
   pkg/Rcpp/inst/include/Rcpp/Date_forward.h
   pkg/Rcpp/inst/include/Rcpp/internal/wrap_forward.h
Modified:
   pkg/Rcpp/inst/include/Rcpp/Date.h
   pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
   pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h
   pkg/Rcpp/inst/include/RcppCommon.h
   pkg/Rcpp/inst/unitTests/runit.Date.R
Log:
support for wrap( std::vector<Date> )

Modified: pkg/Rcpp/inst/include/Rcpp/Date.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Date.h	2010-06-23 03:58:49 UTC (rev 1657)
+++ pkg/Rcpp/inst/include/Rcpp/Date.h	2010-06-23 08:40:15 UTC (rev 1658)
@@ -1,6 +1,6 @@
 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
 //
-// DataFrame.h: Rcpp R/C++ interface class library -- data frames
+// Date.h: Rcpp R/C++ interface class library -- dates
 //
 // Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
 //
@@ -60,6 +60,22 @@
     // template specialisation for wrap() on the date 
     template <> SEXP wrap<Rcpp::Date>(const Rcpp::Date &date);
 
+    // needed to wrap containers of Date such as vector<Date> 
+    // or map<string,Date>
+    namespace internal{
+       template<> inline double caster<Rcpp::Date,double>( Rcpp::Date from){
+       	return static_cast<double>( from.getDate() ) ;
+       }
+       template<> inline Rcpp::Date caster<double,Rcpp::Date>( double from){
+       	return Rcpp::Date( static_cast<int>( from ) ) ;
+       }
+    }
+    
+    template<> inline SEXP wrap_extra_steps<Rcpp::Date>( SEXP x ){
+    	Rf_setAttrib( Rf_install("class"), x, Rf_mkString( "Date" ) ) ;
+    	return x ;
+    }
+	
 }
 
 #endif

Added: pkg/Rcpp/inst/include/Rcpp/Date_forward.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Date_forward.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/Date_forward.h	2010-06-23 08:40:15 UTC (rev 1658)
@@ -0,0 +1,49 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Date_forward.h: Rcpp R/C++ interface class library -- 
+//
+// 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__Date_forward_h
+#define Rcpp__Date_forward_h
+
+namespace Rcpp {
+	class Date ;
+	namespace traits{
+		template <> struct wrap_type_traits<Rcpp::Date>{
+			typedef wrap_type_primitive_tag wrap_category;
+		} ;
+		template<> struct r_type_traits<Rcpp::Date>{ 
+			typedef r_type_primitive_tag r_category ;
+		} ;
+		template<> struct r_type_traits< std::pair<const std::string,Rcpp::Date> >{ 
+			typedef r_type_primitive_tag r_category ;
+		} ;
+		template<> struct r_sexptype_traits<Rcpp::Date>{ 
+			enum{ rtype = REALSXP } ;
+		} ;
+	}
+	
+	template<> SEXP wrap_extra_steps<Rcpp::Date>( SEXP ) ;
+	namespace internal{
+		template<> double caster<Rcpp::Date,double>( Rcpp::Date from) ;
+		template<> Rcpp::Date caster<double,Rcpp::Date>( double from) ;
+	}
+}
+
+#endif

Modified: pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/wrap.h	2010-06-23 03:58:49 UTC (rev 1657)
+++ pkg/Rcpp/inst/include/Rcpp/internal/wrap.h	2010-06-23 08:40:15 UTC (rev 1658)
@@ -30,15 +30,12 @@
 
 namespace Rcpp{
 
-// pre-declaring wrap :
-template <typename T> SEXP wrap(const T& object) ;
-
+template <typename T> SEXP wrap( const T& object ) ;
+	
 namespace internal{
+	template <typename InputIterator> SEXP range_wrap(InputIterator first, InputIterator last) ;
+	template <typename InputIterator> SEXP rowmajor_wrap(InputIterator first, int nrow, int ncol) ;
 
-// pre declaring
-template <typename InputIterator> SEXP range_wrap(InputIterator first, InputIterator last) ;
-template <typename InputIterator> SEXP rowmajor_wrap(InputIterator first, int nrow, int ncol) ;
-
 // {{{ range wrap 
 // {{{ unnamed range wrap
 
@@ -60,6 +57,7 @@
 		caster< T, typename ::Rcpp::traits::storage_type<RTYPE>::type >
 		) ; 
 	UNPROTECT(1) ;
+	// return wrap_extra_steps<T>( x ) ;
 	return x ;
 }
 

Added: pkg/Rcpp/inst/include/Rcpp/internal/wrap_forward.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/wrap_forward.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/internal/wrap_forward.h	2010-06-23 08:40:15 UTC (rev 1658)
@@ -0,0 +1,39 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */
+//
+// wrap.h: Rcpp R/C++ interface class library -- wrap implementations
+//
+// 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_internal_wrap_forward_h
+#define Rcpp_internal_wrap_forward_h
+
+#include <iterator>
+
+// this is a private header, included in RcppCommon.h
+// don't include it directly
+
+namespace Rcpp{
+
+template <typename T> SEXP wrap_extra_steps( const SEXP object ){
+	return object ;
+}
+
+} // Rcpp
+
+#endif

Modified: pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h	2010-06-23 03:58:49 UTC (rev 1657)
+++ pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h	2010-06-23 08:40:15 UTC (rev 1658)
@@ -27,7 +27,7 @@
 namespace traits{
 
 /**
- * Identifies a primitive type that needs to special handling
+ * Identifies a primitive type that needs no special handling
  * int, double, Rbyte, Rcomplex
  */
 struct r_type_primitive_tag{} ;

Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h	2010-06-23 03:58:49 UTC (rev 1657)
+++ pkg/Rcpp/inst/include/RcppCommon.h	2010-06-23 08:40:15 UTC (rev 1658)
@@ -240,6 +240,10 @@
 #include <Rcpp/internal/r_vector.h>
 #include <Rcpp/r_cast.h>
 
+#include <Rcpp/internal/wrap_forward.h>
+
+#include <Rcpp/Date_forward.h>
+
 #include <Rcpp/internal/export.h>
 #include <Rcpp/traits/Exporter.h>
 #include <Rcpp/internal/r_coerce.h>

Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R	2010-06-23 03:58:49 UTC (rev 1657)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R	2010-06-23 08:40:15 UTC (rev 1658)
@@ -20,25 +20,41 @@
 test.Date.ctor.mdy <- function() {
     src <- 'Rcpp::Date dt = Rcpp::Date(12,31,2005);
 	    return Rcpp::wrap(dt);';
-    fun <- cppfunction(signature(), src)
+    fun <- cxxfunction(signature(), src, plugin = "Rcpp" )
     checkEquals(fun(), as.Date("2005-12-31"), msg = "Date.ctor.mdy")
 }
 
 test.Date.ctor.ymd <- function() {
     src <- 'Rcpp::Date dt = Rcpp::Date(2005,12,31);
 	    return Rcpp::wrap(dt);';
-    fun <- cppfunction(signature(), src)
+    fun <- cxxfunction(signature(), src, plugin = "Rcpp" )
     checkEquals(fun(), as.Date("2005-12-31"), msg = "Date.ctor.ymd")
 }
 
 test.Date.ctor.int <- function() {
     src <- 'Rcpp::Date dt = Rcpp::Date(Rcpp::as<int>(d));
 	    return Rcpp::wrap(dt);';
-    fun <- cppfunction(signature(d="numeric"), src)
+    fun <- cxxfunction(signature(d="numeric"), src, plugin = "Rcpp")
     d <- as.Date("2005-12-31")
     checkEquals(fun(as.numeric(d)), d, msg = "Date.ctor.int")
     checkEquals(fun(-1), as.Date("1970-01-01")-1, msg = "Date.ctor.int")
     checkException(fun("foo"), msg = "Date.ctor -> exception" )
 }
 
+test.vector.Date <- function(){
+	fx <- cxxfunction( , '
+		std::vector<Date> v(2) ;
+		v[0] = Date(2005,12,31) ;
+		v[1] = Date(12,31,2005) ;
+		return wrap( v ) ;
+	', plugin = "Rcpp" )
+	
+	checkTrue( 
+		identical( 
+			fx(), 
+			c( as.Date( "2005/12/31",  "2005/12/31" ) )
+		)
+	)
+	
+}
 



More information about the Rcpp-commits mailing list