[Rcpp-commits] r2834 - in pkg/RcppBDT: . R demo src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jan 5 03:50:45 CET 2011
Author: edd
Date: 2011-01-05 03:50:43 +0100 (Wed, 05 Jan 2011)
New Revision: 2834
Added:
pkg/RcppBDT/R/bdt.R
Modified:
pkg/RcppBDT/ChangeLog
pkg/RcppBDT/R/zzz.R
pkg/RcppBDT/demo/RcppBDT.R
pkg/RcppBDT/src/RcppBDT.cpp
Log:
added a few R-level accessor functions
minor tweaks at C++ level and at load-time
Modified: pkg/RcppBDT/ChangeLog
===================================================================
--- pkg/RcppBDT/ChangeLog 2011-01-05 01:29:02 UTC (rev 2833)
+++ pkg/RcppBDT/ChangeLog 2011-01-05 02:50:43 UTC (rev 2834)
@@ -1,3 +1,12 @@
+2011-01-04 Dirk Eddelbuettel <edd at debian.org>
+
+ * R/bdt.R: Added a few accessor functions for R
+
+ * src/RcppBDT.cpp: Added fromDate() setter
+
+ * R/zzz.R: Make both date module and a class global
+ * demo/RcppBDT.R: Adapted demo accordingly
+
2011-01-03 Dirk Eddelbuettel <edd at debian.org>
* src/Makevars.win: Added -I$(BOOSTLIB)
Added: pkg/RcppBDT/R/bdt.R
===================================================================
--- pkg/RcppBDT/R/bdt.R (rev 0)
+++ pkg/RcppBDT/R/bdt.R 2011-01-05 02:50:43 UTC (rev 2834)
@@ -0,0 +1,59 @@
+##
+## bdt.R: Some accessor functions for Boost Date_Time functionality
+##
+## Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+##
+## This file is part of RcppBDT.
+##
+## RcppBDT 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.
+##
+## RcppBDT 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 RcppBDT. If not, see <http://www.gnu.org/licenses/>.
+
+getEndOfBizWeek <- function(d = Sys.Date()) {
+ stopifnot(inherits(d, "Date"))
+ .bdt$getEndOfBizWeek(d)
+}
+
+getEndOfMonth <- function(d = Sys.Date()) {
+ stopifnot(inherits(d, "Date"))
+ .bdt$getEndOfMonth(d)
+}
+
+getYear <- function(d = Sys.Date()) {
+ stopifnot(inherits(d, "Date"))
+ .bdt$fromDate(d)
+ .bdt$getYear()
+}
+
+getMonth <- function(d = Sys.Date()) {
+ stopifnot(inherits(d, "Date"))
+ .bdt$fromDate(d)
+ .bdt$getMonth()
+}
+
+getDay <- function(d = Sys.Date()) {
+ stopifnot(inherits(d, "Date"))
+ .bdt$fromDate(d)
+ .bdt$getDay()
+}
+
+getDayOfWeek <- function(d = Sys.Date()) {
+ stopifnot(inherits(d, "Date"))
+ .bdt$fromDate(d)
+ .bdt$getDayOfWeek()
+}
+
+getDayOfYear <- function(d = Sys.Date()) {
+ stopifnot(inherits(d, "Date"))
+ .bdt$fromDate(d)
+ .bdt$getDayOfYear()
+}
Modified: pkg/RcppBDT/R/zzz.R
===================================================================
--- pkg/RcppBDT/R/zzz.R 2011-01-05 01:29:02 UTC (rev 2833)
+++ pkg/RcppBDT/R/zzz.R 2011-01-05 02:50:43 UTC (rev 2834)
@@ -20,5 +20,7 @@
.onLoad <- function (lib, pack) {
require(methods, quiet=TRUE, warn=FALSE)
- BDTDate <<- Module("bdt")$date
+ .BDTDate <<- Module("bdt")$date
+ .bdt <<- new(.BDTDate)
+ .bdt$setFromUTC()
}
Modified: pkg/RcppBDT/demo/RcppBDT.R
===================================================================
--- pkg/RcppBDT/demo/RcppBDT.R 2011-01-05 01:29:02 UTC (rev 2833)
+++ pkg/RcppBDT/demo/RcppBDT.R 2011-01-05 02:50:43 UTC (rev 2834)
@@ -1,7 +1,7 @@
demo.RcppBDT <- function() {
- require(RcppBDT)
+ require(RcppBDT, quiet=TRUE, warn=FALSE)
## this uses the pretty-printing the Rcpp module logic to show
## all available functions and their docstring
@@ -9,10 +9,11 @@
cat("Demo of setters\n");
## first init a base objects for uses for the functions below
- bd <- new(BDTDate, 2010, 10, 1); cat("From 2010, 10, 1 : ", format(bd$getDate()), "\n")
- ## then assign new values to the base object
+ bd <- new(.BDTDate);
+ ## alternative constructor: new(.BDTDate, 2010, 01, 02)
+ ## then assign new values to the base object -- strings are currently disabled
#bd$fromString("2010-10-02"); cat("From 2010-10-02 : ", format(bd$getDate()), "\n")
- #bd$fromUndelString("20101003"); cat("From 20101003 : ", format(bd$getDate()), "\n")
+ #bd$fromUndelString("20101003"); cat("From 20101003 : ", format(bd$getDate()), "\n")
bd$setFromUTC(); cat("From curr. UTC : ", format(bd$getDate()), "\n")
bd$setFromLocalClock(); cat("From curr. local : ", format(bd$getDate()), "\n")
bd$setEndOfMonth(); cat("end of month : ", format(bd$getDate()), "\n")
Modified: pkg/RcppBDT/src/RcppBDT.cpp
===================================================================
--- pkg/RcppBDT/src/RcppBDT.cpp 2011-01-05 01:29:02 UTC (rev 2833)
+++ pkg/RcppBDT/src/RcppBDT.cpp 2011-01-05 02:50:43 UTC (rev 2834)
@@ -80,12 +80,13 @@
// return Rcpp::Date( ymd.year, ymd.month, ymd.day );
//}
Rcpp::Date date_toDate(boost::gregorian::date *d) { return Rcpp::wrap(*d); } // thanks to wrap() template above
+void date_fromDate(boost::gregorian::date *d, SEXP dt) { *d = Rcpp::as<boost::gregorian::date>(dt); } // thanks to as
// construct end-of-month and first-of-next-month
void date_endOfMonth(boost::gregorian::date *d) { *d = d->end_of_month(); } // not sure why I cannot call end_of_month directly
void date_firstOfNextMonth(boost::gregorian::date *d) { *d = d->end_of_month() + boost::gregorian::days(1); }
// return end-of-month and first-of-next-month for given date
-Rcpp::Date Date_endOfMonth(boost::gregorian::date *d) { return Rcpp::wrap(*d); }
+Rcpp::Date Date_endOfMonth(boost::gregorian::date *d) { return Rcpp::wrap(d->end_of_month()); }
Rcpp::Date Date_firstOfNextMonth(boost::gregorian::date *d) {
boost::gregorian::date dt = d->end_of_month() + boost::gregorian::days(1);
return Rcpp::wrap(dt);
@@ -100,6 +101,7 @@
}
void date_addDays(boost::gregorian::date *d, unsigned len) { *d = *d + boost::gregorian::date_duration(len); }
void date_subtractDays(boost::gregorian::date *d, unsigned len) { *d = *d - boost::gregorian::date_duration(len); }
+// no Rcpp-returning functions here as we can add/substract at the R level already
void date_immDate(boost::gregorian::date *d, int mon, int year) {
// with thanks to Whit Armstong for his rboostdatetime
@@ -150,6 +152,7 @@
#endif
.method("getDate", &date_toDate, "returns an R Date object")
+ .method("fromDate", &date_fromDate, "sets date from an R Date object")
// member functions from the boost date class
// -- does not work as there is another class in between .method("year", &boost::gregorian::date::year)
More information about the Rcpp-commits
mailing list