[Rcpp-commits] r1723 - in pkg/Rcpp: inst inst/include inst/include/Rcpp inst/include/Rcpp/internal inst/unitTests src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Jun 25 09:34:52 CEST 2010


Author: romain
Date: 2010-06-25 09:34:52 +0200 (Fri, 25 Jun 2010)
New Revision: 1723

Added:
   pkg/Rcpp/inst/include/Rcpp/internal/posixt.h
   pkg/Rcpp/src/posixt.cpp
Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/Datetime.h
   pkg/Rcpp/inst/include/Rcpp/config.h
   pkg/Rcpp/inst/include/RcppCommon.h
   pkg/Rcpp/inst/unitTests/runit.Datetime.R
   pkg/Rcpp/inst/unitTests/runit.RcppDatetime.R
   pkg/Rcpp/src/Datetime.cpp
   pkg/Rcpp/src/RcppFunction.cpp
   pkg/Rcpp/src/RcppResultSet.cpp
Log:
anticipating R 2.12.0

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/inst/ChangeLog	2010-06-25 07:34:52 UTC (rev 1723)
@@ -1,3 +1,8 @@
+2010-06-25  Romain Francois <romain at r-enthusiasts.com>
+
+	* inst/include/Rcpp/posix.h: anticipate R 2.12.0 switch of classes
+	POSIXt and POSIXct
+
 2010-06-24  Romain Francois <romain at r-enthusiasts.com>
 
 	* inst/include/Rcpp/vector/RangeIndexer.h: factored the RangeIndexer class

Modified: pkg/Rcpp/inst/include/Rcpp/Datetime.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Datetime.h	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/inst/include/Rcpp/Datetime.h	2010-06-25 07:34:52 UTC (rev 1723)
@@ -72,23 +72,19 @@
     // template specialisation for wrap() on datetime
     template <> SEXP wrap<Rcpp::Datetime>(const Rcpp::Datetime &dt);
 
-    // needed to wrap containers of Date such as vector<Date> or map<string,Date>
+    // needed to wrap containers of Date such as vector<Datetime> or map<string,Datetime>
     namespace internal {
 		template<> inline double caster<Rcpp::Datetime,double>( Rcpp::Datetime from){
-			return static_cast<double>( from.getFractionalTimestamp() ) ;
+			return from.getFractionalTimestamp() ;
 		}
 		template<> inline Rcpp::Datetime caster<double,Rcpp::Datetime>( double from){
-			return Rcpp::Datetime( static_cast<double>( from ) ) ;
+			return Rcpp::Datetime( from ) ;
 		}
     }
     
     template<> inline SEXP wrap_extra_steps<Rcpp::Datetime>( SEXP x ){
-		SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
-		SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
-		SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
-		Rf_setAttrib(x, R_ClassSymbol, datetimeclass); 
-		UNPROTECT(1);
-    	return x ;
+		Rf_setAttrib(x, R_ClassSymbol, internal::getPosixClasses() ); 
+		return x ;
     }
 	
 }

Modified: pkg/Rcpp/inst/include/Rcpp/config.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/config.h	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/inst/include/Rcpp/config.h	2010-06-25 07:34:52 UTC (rev 1723)
@@ -29,6 +29,5 @@
 #define RCPP_HAS_DEMANGLING
 #endif
 
-
 #endif
 

Added: pkg/Rcpp/inst/include/Rcpp/internal/posixt.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/posixt.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/internal/posixt.h	2010-06-25 07:34:52 UTC (rev 1723)
@@ -0,0 +1,36 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*-
+//
+// posixt.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__internal__posixt_h
+#define Rcpp__internal__posixt_h
+
+namespace Rcpp{
+namespace internal{
+	
+SEXP getPosixClasses() ;
+SEXP new_posixt_object( double d) ;
+SEXP new_date_object( double d) ;
+
+
+}
+}
+
+#endif

Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/inst/include/RcppCommon.h	2010-06-25 07:34:52 UTC (rev 1723)
@@ -109,12 +109,17 @@
 #include <Rversion.h>
 #define RCPP_GET_NAMES(x)	Rf_getAttrib(x, R_NamesSymbol)
 
+#if defined(R_VERSION) && R_VERSION >= R_Version(2, 12, 0)
+#define R_2_12_0
+#endif
+
 // #ifdef BUILDING_DLL
 // #define RcppExport extern "C" __declspec(dllexport)
 // #else
 #define RcppExport extern "C"
 // #endif
 
+#include <Rcpp/internal/posixt.h>
 
 namespace Rcpp{
 	namespace internal{

Modified: pkg/Rcpp/inst/unitTests/runit.Datetime.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Datetime.R	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/inst/unitTests/runit.Datetime.R	2010-06-25 07:34:52 UTC (rev 1723)
@@ -49,9 +49,7 @@
                 msg = "Datetime.operators")
 }
 
-
-# commented out for now : fails in europe
-test.RcppDatetime.wrap <- function() {
+test.Datetime.wrap <- function() {
     src <- 'Datetime dt = Datetime(981162123.123456);
 	    return wrap(dt);';
     fun <- cxxfunction(signature(), src, plugin = "Rcpp" )

Modified: pkg/Rcpp/inst/unitTests/runit.RcppDatetime.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppDatetime.R	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/inst/unitTests/runit.RcppDatetime.R	2010-06-25 07:34:52 UTC (rev 1723)
@@ -52,12 +52,11 @@
                       list(diff=3600, bigger=1, smaller=0, equal=0, ge=1, le=0), msg = "RcppDatetime.operators")
 }
 
-# commented out for now : fails in europe
-#test.RcppDatetime.wrap <- function() {
-#    src <- 'RcppDatetime dt = RcppDatetime(981183723.123456);
-#	    return wrap(dt);';
-#    funx <- cxxfunction(signature(), src, plugin = "Rcpp" )
-#    checkEquals(as.numeric(funx()), as.numeric(as.POSIXct("2001-02-03 01:02:03.123456")),
-#                msg = "RcppDatetime.wrap")
-#}
+test.RcppDatetime.wrap <- function() {
+    src <- 'RcppDatetime dt = RcppDatetime(981162123.123456);
+	    return wrap(dt);';
+    funx <- cxxfunction(signature(), src, plugin = "Rcpp" )
+    checkEquals(as.numeric(funx()), as.numeric(as.POSIXct("2001-02-03 01:02:03.123456", tz="UTC")),
+                msg = "RcppDatetime.wrap")
+}
 

Modified: pkg/Rcpp/src/Datetime.cpp
===================================================================
--- pkg/Rcpp/src/Datetime.cpp	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/src/Datetime.cpp	2010-06-25 07:34:52 UTC (rev 1723)
@@ -89,14 +89,7 @@
     bool    operator!=(const Datetime &d1, const Datetime& d2) { return d1.m_dt != d2.m_dt; }
 
     template <> SEXP wrap(const Datetime &date) {
-		SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
-		REAL(value)[0] = date.getFractionalTimestamp();
-		SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
-		SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
-		SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
-		Rf_setAttrib(value, R_ClassSymbol, datetimeclass); 
-		UNPROTECT(2);
-		return value;
+		return internal::new_posixt_object( date.getFractionalTimestamp() ) ;
     }
 
 }

Modified: pkg/Rcpp/src/RcppFunction.cpp
===================================================================
--- pkg/Rcpp/src/RcppFunction.cpp	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/src/RcppFunction.cpp	2010-06-25 07:34:52 UTC (rev 1723)
@@ -127,14 +127,9 @@
 void RcppFunction::appendToRList(std::string name, RcppDatetime& datetime) {
     if (currListPosn < 0 || currListPosn >= listSize)
 	throw std::range_error("RcppFunction::appendToRlist(RcppDatetime): list posn out of range");
-    SEXP valsxp = PROTECT(Rf_allocVector(REALSXP,1));
+    SEXP valsxp = PROTECT(Rf_ScalarReal(datetime.getFractionalTimestamp()));
     numProtected++;
-    REAL(valsxp)[0] = datetime.getFractionalTimestamp();
-    SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP, 2));
-    numProtected++;
-    SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
-    SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
-    Rf_setAttrib(valsxp, R_ClassSymbol, datetimeclass);
+    Rf_setAttrib(valsxp, R_ClassSymbol, Rcpp::internal::getPosixClasses() );
     SET_VECTOR_ELT(listArg, currListPosn++, valsxp);
     names.push_back(name);
 }

Modified: pkg/Rcpp/src/RcppResultSet.cpp
===================================================================
--- pkg/Rcpp/src/RcppResultSet.cpp	2010-06-25 03:56:52 UTC (rev 1722)
+++ pkg/Rcpp/src/RcppResultSet.cpp	2010-06-25 07:34:52 UTC (rev 1723)
@@ -29,28 +29,18 @@
 
     // template specialisation for wrap() on the date and datetime classes
     template <> SEXP wrap(const RcppDate &date) {
-	SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
-	REAL(value)[0] = date.getJDN() - RcppDate::Jan1970Offset;
-	Rf_setAttrib(value, R_ClassSymbol, Rf_mkString("Date")); 
-	UNPROTECT(1);
-	return value;
+    return internal::new_date_object( date.getJDN() - RcppDate::Jan1970Offset ) ;
     }
 
     template <> SEXP wrap(const RcppDatetime &datetime) {
-	SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));
-	REAL(value)[0] = datetime.getFractionalTimestamp();
-	SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
-	SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
-	SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
-	Rf_setAttrib(value, R_ClassSymbol, datetimeclass); 
-	UNPROTECT(2);
-	return value;
-    }
+    return internal::new_posixt_object( datetime.getFractionalTimestamp() ) ;
+	}
 
     template <> SEXP wrap(const RcppDateVector& datevec) {
 	SEXP value = PROTECT(Rf_allocVector(REALSXP, datevec.size()));
-	for (int i = 0; i < datevec.size(); i++) {
-	    REAL(value)[i] = datevec(i).getJDN() - RcppDate::Jan1970Offset;
+	double* p = REAL(value) ;
+	for (int i = 0; i < datevec.size(); i++,p++) {
+	    *p = datevec(i).getJDN() - RcppDate::Jan1970Offset;
 	}
 	Rf_setAttrib(value, R_ClassSymbol, Rf_mkString("Date")); 
 	UNPROTECT(1);
@@ -59,14 +49,12 @@
 
     template <> SEXP wrap(const RcppDatetimeVector &dtvec) {
 	SEXP value = PROTECT(Rf_allocVector(REALSXP, dtvec.size()));
-	for (int i = 0; i < dtvec.size(); i++) {
-	    REAL(value)[i] = dtvec(i).getFractionalTimestamp();
+	double* p = REAL(value) ;
+	for (int i = 0; i < dtvec.size(); i++,p++) {
+	    *p = dtvec(i).getFractionalTimestamp();
 	}
-	SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
-	SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
-	SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
-	Rf_setAttrib(value, R_ClassSymbol, datetimeclass); 
-	UNPROTECT(2);
+	Rf_setAttrib(value, R_ClassSymbol, internal::getPosixClasses() ); 
+	UNPROTECT(1);
 	return value;
     }
 
@@ -334,11 +322,7 @@
 		// more proper to use the proper accessor (and if we ever added code ...)
 		REAL(value)[j] = table[j][i].getDatetimeValue().getFractionalTimestamp();
 	    }
-	    SEXP dateclass = PROTECT(Rf_allocVector(STRSXP,2));
-	    numProtected++;
-	    SET_STRING_ELT(dateclass, 0, Rf_mkChar("POSIXt"));
-	    SET_STRING_ELT(dateclass, 1, Rf_mkChar("POSIXct"));
-	    Rf_setAttrib(value, R_ClassSymbol, dateclass); 
+	    Rf_setAttrib(value, R_ClassSymbol, Rcpp::internal::getPosixClasses() );
 	} else {
 	    throw std::range_error("RcppResultSet::add invalid column type");
 	}

Added: pkg/Rcpp/src/posixt.cpp
===================================================================
--- pkg/Rcpp/src/posixt.cpp	                        (rev 0)
+++ pkg/Rcpp/src/posixt.cpp	2010-06-25 07:34:52 UTC (rev 1723)
@@ -0,0 +1,56 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// posixt.h: Rcpp R/C++ interface class library -- Date type
+//
+// 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>
+
+namespace Rcpp{
+namespace internal{
+	
+SEXP getPosixClasses(){
+	SEXP datetimeclass = PROTECT(Rf_allocVector(STRSXP,2));
+#ifdef R_2_12_0
+	SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXt"));
+	SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXct"));
+#else
+	SET_STRING_ELT(datetimeclass, 0, Rf_mkChar("POSIXct"));
+	SET_STRING_ELT(datetimeclass, 1, Rf_mkChar("POSIXt"));
+#endif
+	UNPROTECT(1) ;
+	return datetimeclass ;
+}
+
+SEXP new_posixt_object( double d){
+	SEXP x = PROTECT( Rf_ScalarReal( d ) ) ;
+	Rf_setAttrib(x, R_ClassSymbol, getPosixClasses() ); 
+	UNPROTECT(1); 
+	return x ;	
+}
+
+SEXP new_date_object( double d){
+	SEXP x = PROTECT(Rf_ScalarReal( d ) ) ;
+	Rf_setAttrib(x, R_ClassSymbol, Rf_mkString("Date")); 
+	UNPROTECT(1);
+	return x;
+}
+
+	
+}
+}



More information about the Rcpp-commits mailing list