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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 24 17:37:38 CEST 2010


Author: edd
Date: 2010-06-24 17:37:38 +0200 (Thu, 24 Jun 2010)
New Revision: 1714

Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/Date.h
   pkg/Rcpp/inst/unitTests/runit.Date.R
   pkg/Rcpp/src/Date.cpp
Log:
struct tm component for Date plus accessors for extra-daily data
added SEXP ctor
addes tests


Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-06-24 12:57:22 UTC (rev 1713)
+++ pkg/Rcpp/inst/ChangeLog	2010-06-24 15:37:38 UTC (rev 1714)
@@ -1,16 +1,9 @@
-2010-06-16/24  Romain Francois <romain at r-enthusiasts.com>
+2010-06-24  Dirk Eddelbuettel  <edd at debian.org>
 
-	* inst/include/Rcpp/sugar/*: implementation of Rcpp sugar, covering
-	binary operators (<,>,<=,>=,!=,==) for logical vectors or logical expressions, 
-	arithmetic operators (+,-,*,/) for vectors and expressions, and several 
-	functions similar to the R functions of the same name, currently: 
-	abs, all, any, ceiling, diff, exp, ifelse, is_na, lapply, pmin, pmax, 
-	pow, sapply, seq_along, seq_len, sign
-	
-	* inst/doc/Rcpp-sugar/Rcpp-sugar.Rnw: vignette documenting Rcpp sugar
-	
-	* inst/examples/ConvolveBenchmarks: version of the convolution function
-	using sugar indexing. 
+	* inst/include/Rcpp/Date.h: add struct tm member variable and
+	sensible (ie non-intra-day) accessor functions; add SEXP ctor
+	* src/Date.cpp: Implementation of the above
+	* inst/unitTests/runit.Date.R: tests for the above
 
 2010-06-23  Dirk Eddelbuettel  <edd at debian.org>
 
@@ -42,6 +35,20 @@
 	* inst/include/RcppDoxygenExamples.h: Correct three wrong paths for
 	ConvolveBenchmak example files, and add missing FastLM/ examples
 
+2010-06-18  Romain Francois <romain at r-enthusiasts.com>
+
+	* inst/include/Rcpp/sugar/*: implementation of Rcpp sugar, covering
+	binary operators (<,>,<=,>=,!=,==) for logical vectors or logical
+	expressions, arithmetic operators (+,-,*,/) for vectors and
+	expressions, and several functions similar to the R functions of the
+	same name, currently: abs, all, any, ceiling, diff, exp, ifelse,
+	is_na, lapply, pmin, pmax, pow, sapply, seq_along, seq_len, sign
+
+	* inst/doc/Rcpp-sugar/Rcpp-sugar.Rnw: vignette documenting Rcpp sugar
+
+	* inst/examples/ConvolveBenchmarks: version of the convolution function
+	using sugar indexing.
+
 2010-06-17  Romain Francois <romain at r-enthusiasts.com>
 
 	* inst/include/Rcpp/Vector.h: split into more manageable files

Modified: pkg/Rcpp/inst/include/Rcpp/Date.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Date.h	2010-06-24 12:57:22 UTC (rev 1713)
+++ pkg/Rcpp/inst/include/Rcpp/Date.h	2010-06-24 15:37:38 UTC (rev 1714)
@@ -29,14 +29,25 @@
     class Date {
     public:	
 		Date();
+		Date(SEXP s); 
 		Date(const int &dt);	// from integer, just like R (with negative dates before Jan 1, 1970)
 		Date(const std::string &s, const std::string &fmt="%Y-%m-%d");
 		Date(const unsigned int &m, const unsigned int &d, const unsigned int &y); 
 		Date(const Date &copy);
 		~Date() {};
 		
-		int getDate(void) const { return d; } 
+		int getDate(void) const { return m_d; } 
 
+		// intra-day useless for date class
+		//int getSeconds() const { return m_tm.tm_sec; }
+		//int getMinutes() const { return m_tm.tm_min; }
+		//int getHours()   const { return m_tm.tm_hour; }
+		int getDay()     const { return m_tm.tm_mday; }
+		int getMonth()   const { return m_tm.tm_mon + 1; } 		// makes it 1 .. 12
+		int getYear()    const { return m_tm.tm_year + 1900; }
+		int getWeekday() const { return m_tm.tm_wday + 1; } 	// makes it 1 .. 7
+		int getYearday() const { return m_tm.tm_yday + 1; }     // makes it 1 .. 366
+
 		static const int QLtoJan1970Offset;  // Offset between R / Unix epoch date and the QL base date
 
 		Date & operator=(const Date &newdate); 		// copy assignment operator 
@@ -52,10 +63,12 @@
 		friend bool  operator!=(const Date &date1, const Date& date2);
 
     private:
-        int d;					// day number, relative to epoch of Jan 1, 1970
+        int m_d;					// day number, relative to epoch of Jan 1, 1970
+        struct tm m_tm;				// standard time representation
 
+		void update_tm();			// update m_tm based on m_d
+
 		double mktime00(struct tm &tm) const; // from R's src/main/datetime.c
-
     };
 
 

Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R	2010-06-24 12:57:22 UTC (rev 1713)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R	2010-06-24 15:37:38 UTC (rev 1714)
@@ -17,6 +17,17 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
+test.Date.ctor.sexp <- function() {
+    src <- 'Date dt = Date(d);
+	    return wrap(dt);'
+    fun <- cxxfunction(signature(d="Date"), src, plugin = "Rcpp" )
+    d <- as.Date("2005-12-31"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.1")
+    d <- as.Date("1970-01-01"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.2")
+    d <- as.Date("1969-12-31"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.3")
+    d <- as.Date("1954-07-04"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.4") # cf 'Miracle of Berne' ;-)
+    d <- as.Date("1789-07-14"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.5") # cf 'Quatorze Juillet' ;-)
+}
+
 test.Date.ctor.mdy <- function() {
     src <- 'Date dt = Date(12,31,2005);
 	    return wrap(dt);'
@@ -57,6 +68,19 @@
                 msg = "Date.operators")
 }
 
+test.Date.components <- function() {
+    src <- 'Date d = Date(2005,12,31);
+            return List::create(Named("day") = d.getDay(),
+                                Named("month") = d.getMonth(),
+                                Named("year") = d.getYear(),
+                                Named("weekday") = d.getWeekday(),
+                                Named("yearday") = d.getYearday());'
+    fun <- cxxfunction(signature(), src, plugin="Rcpp")
+    checkEquals(fun(),
+                list(day=31, month=12, year=2005, weekday=7, yearday=365),
+                msg = "Date.components")
+}
+
 test.vector.Date <- function(){
 	fx <- cxxfunction( , '
 		std::vector<Date> v(2) ;

Modified: pkg/Rcpp/src/Date.cpp
===================================================================
--- pkg/Rcpp/src/Date.cpp	2010-06-24 12:57:22 UTC (rev 1713)
+++ pkg/Rcpp/src/Date.cpp	2010-06-24 15:37:38 UTC (rev 1714)
@@ -30,48 +30,62 @@
     const int Date::QLtoJan1970Offset = 25569;  // Offset between R / Unix epoch date and the QL base date
 
     Date::Date() {
-	d = 0; 
+	m_d = 0; 
+	update_tm();
     };
 
+    Date::Date(SEXP d) {
+	m_d = Rcpp::as<int>(d); 
+	update_tm();
+    };
+
     Date::Date(const int &dt) {
-	d = dt;
+	m_d = dt;
+	update_tm();
     }
 
     Date::Date(const std::string &s, const std::string &fmt) {
 	Rcpp::Function strptime("strptime");	// we cheat and call strptime() from R
-	d = Rcpp::as<int>(strptime(s, fmt));
+	m_d = Rcpp::as<int>(strptime(s, fmt));
+	update_tm();
     }
 
     Date::Date(const unsigned int &mon, const unsigned int &day, const unsigned int &year) {
 
-	struct tm tm;;
-	tm.tm_sec = tm.tm_min = tm.tm_hour = tm.tm_isdst = 0;
+	m_tm.tm_sec = m_tm.tm_min = m_tm.tm_hour = m_tm.tm_isdst = 0;
 
 	// allow for ISO-notation case (yyyy, mm, dd) which we prefer over (mm, dd, year)
 	if (mon >= 1900 && day <= 12 && year <= 31) {
-	    tm.tm_year = mon - 1900;
-	    tm.tm_mon  = day - 1;       // range 0 to 11
-	    tm.tm_mday = year;
+	    m_tm.tm_year = mon - 1900;
+	    m_tm.tm_mon  = day - 1;     // range 0 to 11
+	    m_tm.tm_mday = year;
 	} else {
-	    tm.tm_mday  = day;
-	    tm.tm_mon   = mon - 1;	// range 0 to 11
-	    tm.tm_year  = year - 1900;
+	    m_tm.tm_mday  = day;
+	    m_tm.tm_mon   = mon - 1;	// range 0 to 11
+	    m_tm.tm_year  = year - 1900;
 	}
-	double tmp = mktime00(tm); 	// use mktime() replacement borrowed from R
-	d = tmp/(24*60*60);
+	double tmp = mktime00(m_tm); 	// use mktime() replacement borrowed from R
+	m_d = tmp/(24*60*60);
     }
 
     Date::Date(const Date &copy) {
-	d = copy.d;
+	m_d = copy.m_d;
+	m_tm = copy.m_tm;
     }
 
     Date & Date::operator=(const Date & newdate) {
 	if (this != &newdate) {
-	    d = newdate.d;
+	    m_d = newdate.m_d;
+	    m_tm = newdate.m_tm;
 	}
 	return *this;
     }
 
+    void Date::update_tm() {
+	time_t t = 24*60*60 * m_d;	// days since epoch to seconds since epoch
+	m_tm = *gmtime(&t);		// this may need a Windows fix, re-check R's datetime.c
+    }
+
     // Taken from R's src/main/datetime.c and made a member function called with C++ reference
     /* Substitute for mktime -- no checking, always in GMT */
     double Date::mktime00(struct tm &tm) const {
@@ -116,18 +130,18 @@
     }
 
     Date operator+(const Date &date, int offset) {
-	Date newdate(date.d);
-	newdate.d += offset;
+	Date newdate(date.m_d);
+	newdate.m_d += offset;
 	return newdate;
     }
 
-    int   operator-(const Date& d1, const Date& d2) { return d2.d - d1.d; }
-    bool  operator<(const Date &d1, const Date& d2) { return d1.d < d2.d; }
-    bool  operator>(const Date &d1, const Date& d2) { return d1.d > d2.d; }
-    bool  operator==(const Date &d1, const Date& d2) { return d1.d == d2.d; };
-    bool  operator>=(const Date &d1, const Date& d2) { return d1.d >= d2.d; };
-    bool  operator<=(const Date &d1, const Date& d2) { return d1.d <= d2.d; };
-    bool  operator!=(const Date &d1, const Date& d2) { return d1.d != d2.d; };
+    int   operator-(const Date& d1, const Date& d2) { return d2.m_d - d1.m_d; }
+    bool  operator<(const Date &d1, const Date& d2) { return d1.m_d < d2.m_d; }
+    bool  operator>(const Date &d1, const Date& d2) { return d1.m_d > d2.m_d; }
+    bool  operator==(const Date &d1, const Date& d2) { return d1.m_d == d2.m_d; };
+    bool  operator>=(const Date &d1, const Date& d2) { return d1.m_d >= d2.m_d; };
+    bool  operator<=(const Date &d1, const Date& d2) { return d1.m_d <= d2.m_d; };
+    bool  operator!=(const Date &d1, const Date& d2) { return d1.m_d != d2.m_d; };
 
     template <> SEXP wrap(const Date &date) {
 	SEXP value = PROTECT(Rf_allocVector(REALSXP, 1));



More information about the Rcpp-commits mailing list