initial commit

ChangeLog

@@ -0,0 +1,20 @@
+2011-01-02  Dirk Eddelbuettel  <edd@debian.org>
+
+	* R/RcppBDT.Rcpp: Modified modules wrapper name to make it clearer
+	which function set and which functions get or convert data
+
+	* tests/RcppBDT.R: Define simplest test of just calling demo()
+
+2011-01-01  Dirk Eddelbuettel  <edd@debian.org>
+
+	* demo/RcppBDT.R: Added RcppBDT demo showing a few functions
+
+2010-12-24  Dirk Eddelbuettel  <edd@debian.org>
+
+	* Added a few more functions
+
+	* DESCRIPTION: Set up as a simple package
+
+2010-12-23  Dirk Eddelbuettel  <edd@debian.org>
+
+	* First draft version as an inline version

DESCRIPTION

@@ -0,0 +1,16 @@
+Package: RcppBDT
+Type: Package
+Title: Rcpp bindings for the Boost Date_Time library 
+Version: 0.0.1
+Date: $Date$
+Author: Dirk Eddelbuettel
+Maintainer: Romain Francois <romain@r-enthusiasts.com>
+Description: This package provides R with access to Boost Date_Time
+ functonality by using Rcpp modules. 
+ .
+ Currently only Date functionality is covered.
+License: GPL (>= 2)
+LazyLoad: yes
+Depends: Rcpp (>= 0.9.0), methods
+LinkingTo: Rcpp
+

NAMESPACE

@@ -0,0 +1,4 @@
+import(Rcpp)
+useDynLib(RcppBDT)
+exportPattern("^[[:alpha:]]+")
+

R/ChangeLog

@@ -0,0 +1,7 @@
+2011-01-01  Dirk Eddelbuettel  <edd@debian.org>
+
+	* DESCRIPTION: Putting a first 0.0.1 release together as a package
+
+2010-12-24  Dirk Eddelbuettel  <edd@debian.org>
+
+	* Some first exploration with Rcpp modules around Boost Date.Time

R/zzz.R

@@ -0,0 +1,24 @@
+##
+## zzz.R: Loading Rcpp and Boost Date_Time glue
+##
+## 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/>.
+
+.onLoad <- function (lib, pack) {
+    require(methods, quiet=TRUE, warn=FALSE)
+    BDTDate <<- Module("bdt")$date
+}

demo/00Index

@@ -0,0 +1 @@
+RcppBDT	 Boost Date.Time functionality accessible via Rcpp

demo/RcppBDT.R

@@ -0,0 +1,35 @@
+
+demo.RcppBDT  <- function() {
+
+    require(RcppBDT)
+
+    ## this uses the pretty-printing the Rcpp module logic to show
+    ## all available functions and their docstring
+    #print(BDTDate)
+
+    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$getString()), "\n")
+    ## then assign new values to the base object
+    bd$fromString("2010-10-02"); 	cat("From 2010-10-02  : ", format(bd$getString()), "\n")
+    bd$fromUndelString("20101003");     cat("From 20101003    : ", format(bd$getString()), "\n")
+    bd$setFromUTC(); 			cat("From curr. UTC   : ", format(bd$getString()), "\n")
+    bd$setFromLocalClock();		cat("From curr. local : ", format(bd$getString()), "\n")
+    bd$setEndOfMonth(); 		cat("end of month     : ", format(bd$getString()), "\n")
+    bd$setFirstOfNextMonth(); 		cat("1st of next Month: ", format(bd$getString()), "\n")
+    bd$addDays(4);                      cat("plus four days   : ", format(bd$getString()), "\n")
+    bd$subtractDays(3);                 cat("minus three  s   : ", format(bd$getString()), "\n")
+
+    bd$setIMMDate(12, 2010); 		cat("IMM Date Dec 2010: ", format(bd$getString()), "\n")
+    bd$setEndOfBizWeek();  		cat("end of biz week  : ", format(bd$getString()), "\n")
+
+    cat("\nDemo of getters\n")
+    ## now just functions that return values to R
+    cat("From curr. local : ", format(bd$getLocalClock()), "\n")
+    bd$setFromLocalClock();
+    cat("end of biz week  : ", format(bd$getEndOfBizWeek()), "\n")
+    cat("end of of month  : ", format(bd$getEndOfMonth()), "\n")
+    cat("1st of next month: ", format(bd$getFirstOfNextMonth()), "\n")
+}
+
+demo.RcppBDT()

inst/include/RcppBDT.h

@@ -0,0 +1,40 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RcppBDT.h: Rcpp and Boost Date_Time glue
+//
+// 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/>.
+
+#ifndef RCPPBDT__RCPPBDT_H
+#define RCPPBDT__RCPPBDT_H
+
+#include <RcppCommon.h>
+
+//#include <boost/date_time.hpp>
+#include <boost/date_time/gregorian/gregorian.hpp> 	// Gregorian calendar types, including I/O
+
+namespace Rcpp {
+    // non-intrusive extension via template specialisation
+    template <> boost::gregorian::date as( SEXP dt ) throw(not_compatible);
+
+    // non-intrusive extension via template specialisation
+    template <> SEXP wrap(const boost::gregorian::date &d) throw(not_compatible);
+}
+
+#include <Rcpp.h>
+
+#endif

man/RcppBDT-package.Rd

@@ -0,0 +1,31 @@
+\name{RcppBDT-package}
+\alias{RcppBDT-package}
+\alias{RcppBDT}
+\docType{package}
+\title{
+  Bindings for Boost Date_Time
+}
+\description{
+  This package provides R with access to Boost Date_Time
+  functonality by using Rcpp modules. Currently only Date functionality 
+  is covered.  
+}
+\details{
+\tabular{ll}{
+Package: \tab RcppBDT\cr
+Type: \tab Package\cr
+Version: \tab 0.0.1\cr
+Date: \tab $Date$\cr
+License: \tab GPL (>= 2)\cr
+LazyLoad: \tab yes\cr
+}
+}
+\author{
+  Dirk Eddelbuettel <edd@debian.org>
+  Maintainer: Dirk Eddelbuettel <edd@debian.org>
+}
+\references{
+  Boost Date_Time: \url{http://www.boost.org/doc/html/date_time.html}
+}
+\keyword{package}
+

src/Makevars

@@ -0,0 +1,3 @@
+## Use the R_HOME indirection to support installations of multiple R version
+PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"` -lboost_date_time
+PKG_CPPFLAGS += -I../inst/include/

src/Makevars.win

@@ -0,0 +1,7 @@
+
+## TODO: Boost option
+
+## Use the R_HOME indirection to support installations of multiple R version
+PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()") 
+PKG_CPPFLAGS += -I../inst/include/
+

src/RcppBDT.cpp

@@ -0,0 +1,168 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RcppBDT.cpp: Rcpp and Boost Date_Time glue
+//
+// 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/>.
+
+#include <RcppBDT.h>
+
+// define template specialisations for as and wrap
+namespace Rcpp {
+    template <> boost::gregorian::date as( SEXP dtsexp ) throw(not_compatible) {
+        Rcpp::Date dt(dtsexp);
+        return boost::gregorian::date(dt.getYear(), dt.getMonth(), dt.getDay());
+    }
+
+    template <> SEXP wrap(const boost::gregorian::date &d) throw(not_compatible) {
+        boost::gregorian::date::ymd_type ymd = d.year_month_day();     // convert to y/m/d struct
+        return Rcpp::wrap(Rcpp::Date( ymd.year, ymd.month, ymd.day ));
+    }
+}
+
+void date_print(boost::gregorian::date *d) {
+    std::cout << *d << std::endl;
+}
+
+// set the date d to the date from the supplied string s
+void date_fromString(boost::gregorian::date *d, std::string s) { 
+    *d = boost::gregorian::date(boost::gregorian::from_string(s)); 
+}
+void date_fromUndelString(boost::gregorian::date *d, std::string s) { 
+    *d = boost::gregorian::date(boost::gregorian::from_undelimited_string(s)); 
+}
+// return the date to R as an R type
+Rcpp::Date Date_fromString(boost::gregorian::date *d, std::string s) { 
+    return Rcpp::wrap(boost::gregorian::date(boost::gregorian::from_string(s))); 
+}
+Rcpp::Date Date_fromUndelString(boost::gregorian::date *d, std::string s) { 
+    return Rcpp::wrap(boost::gregorian::date(boost::gregorian::from_undelimited_string(s))); 
+}
+
+// these set the date from the clock, in local or universal time
+void date_localDay(boost::gregorian::date *d) { *d = boost::gregorian::date(boost::gregorian::day_clock::local_day()); }
+void date_utcDay(boost::gregorian::date *d) { *d = boost::gregorian::date(boost::gregorian::day_clock::universal_day()); }
+Rcpp::Date Date_localDay(boost::gregorian::date *d) { return Rcpp::wrap(boost::gregorian::date(boost::gregorian::day_clock::local_day())); }
+Rcpp::Date Date_utcDay(boost::gregorian::date *d) { return Rcpp::wrap(boost::gregorian::date(boost::gregorian::day_clock::universal_day())); }
+
+// these extract the requested date portion or representation as an integer
+int date_year(boost::gregorian::date *d) { return static_cast<int>( d->year() ); }
+int date_month(boost::gregorian::date *d) { return static_cast<int>( d->month() ); }
+int date_day(boost::gregorian::date *d) { return static_cast<int>( d->day() ); }
+int date_dayofweek(boost::gregorian::date *d) { return static_cast<int>( d->day_of_week() ); }
+int date_dayofyear(boost::gregorian::date *d) { return static_cast<int>( d->day_of_year() ); }
+
+// these extract the requested date portion or representation as an integer
+std::string date_toString(boost::gregorian::date *d) { return boost::gregorian::to_simple_string(*d); }
+std::string date_toIsoString(boost::gregorian::date *d) { return boost::gregorian::to_iso_string(*d); }
+std::string date_toExtIsoString(boost::gregorian::date *d) { return boost::gregorian::to_iso_extended_string(*d); }
+
+//Date date_toDate(date *d) { // earlier form before wrap()
+//    date::ymd_type ymd = d->year_month_day();
+//    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
+
+// 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_firstOfNextMonth(boost::gregorian::date *d) { 
+    boost::gregorian::date dt = d->end_of_month() + boost::gregorian::days(1);
+    return Rcpp::wrap(dt); 
+}
+
+static const boost::gregorian::greg_weekday friday(boost::gregorian::Friday);
+void date_endOfBizWeek(boost::gregorian::date *d) { *d += days_until_weekday(*d, friday); }
+Rcpp::Date Date_endOfBizWeek(boost::gregorian::date *d) { 
+    boost::gregorian::date dt = *d;
+    dt += days_until_weekday(*d, friday);
+    return Rcpp::wrap(dt); 
+}
+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); }
+
+void date_immDate(boost::gregorian::date *d, int mon, int year) {
+    // with thanks to Whit Armstong for his rboostdatetime
+    typedef boost::gregorian::nth_day_of_the_week_in_month nth_dow;
+
+    nth_dow ans_generator(nth_dow::third, boost::gregorian::Wednesday, mon);
+    *d = ans_generator.get_date(year);
+}
+
+
+RCPP_MODULE(bdt) {
+
+    using namespace boost::gregorian;
+    using namespace Rcpp;
+
+    // exposing a class (boost::gregorian::)date as "date" on the R side
+    class_<date>("date")
+
+    // constructors
+    .constructor("default constructor")
+    .constructor<int, int, int>("constructor from year, month, day")
+
+    // free functions defined above with date* as first argument
+    .method("fromString", &date_fromString, "create a date from a delimited string")
+    .method("fromUndelString", &date_fromUndelString, "create a date from an un delimited string")
+    .method("getDateFromString", &Date_fromString, "return a date from a delimited string")
+    .method("getDateFromUndelString", &Date_fromUndelString, "return a date from an un delimited string")
+
+    .method("setFromLocalClock", &date_localDay, "create a date from current local clock")
+    .method("setFromUTC", &date_utcDay, "create a date from current universal clock")
+    .method("getLocalClock", &Date_localDay, "return a date from local time")
+    .method("getUTC", &Date_utcDay, "return a date from UTC time")
+
+    //.method("print", &date_print, "print date to stdout")
+
+    .method("getYear", &date_year, "returns the year")
+    .method("getMonth", &date_month, "returns the month")
+    .method("getDay", &date_day, "returns the day")
+    .method("getDayOfWeek", &date_dayofweek, "returns the day of the week")
+    .method("getDayOfYear", &date_dayofyear, "returns the day of the year")
+
+    .method("getString", &date_toString, "returns a string representation")
+    .method("getIsoString", &date_toIsoString, "returns an ISO string representation")
+    .method("getExtIsoString", &date_toExtIsoString, "returns an extended ISO string representation")
+
+    .method("getDate", &date_toDate, "returns 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)
+    //                                                        .method("month", &date::month)
+    .const_method("getWeekNumber", &date::week_number, "returns the number of the week")
+    .const_method("getModJulian", &date::modjulian_day, "returns the modified Julian day")
+    .const_method("getJulian", &date::julian_day, "returns the Julian day")
+
+    .method("setEndOfMonth", &date_endOfMonth, "return the last day of the month for given date")
+    .method("setFirstOfNextMonth", &date_firstOfNextMonth, "return the first day of the next month for given date")
+    .method("getEndOfMonth", &Date_endOfMonth, "return the last day of the month for given date")
+    .method("getFirstOfNextMonth", &Date_firstOfNextMonth, "return the first day of the next month for given date")
+
+    .method("setEndOfBizWeek", &date_endOfBizWeek, "return the Friday of the week for given date")
+    .method("getEndOfBizWeek", &Date_endOfBizWeek, "return the Friday of the week for given date")
+
+    .method("addDays", &date_addDays, "adds days to given date")
+    .method("subtractDays", &date_subtractDays, "subtract days from given date")
+
+    .method("setIMMDate", &date_immDate, "return third Wednesday in given month and year")
+
+    ;
+
+}

tests/RcppBDT.R

@@ -0,0 +1,2 @@
+
+demo(RcppBDT, package="RcppBDT")