[Rcpp-commits] r2852 - in pkg/RcppBDT: . R demo src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Jan 8 19:08:07 CET 2011


Author: edd
Date: 2011-01-08 19:08:07 +0100 (Sat, 08 Jan 2011)
New Revision: 2852

Modified:
   pkg/RcppBDT/ChangeLog
   pkg/RcppBDT/NAMESPACE
   pkg/RcppBDT/R/bdt.R
   pkg/RcppBDT/R/zzz.R
   pkg/RcppBDT/demo/RcppBDT.R
   pkg/RcppBDT/src/RcppBDT.cpp
Log:
added two new functions for date of first and last weekday in a given month and year (eg first Friday in Jan 2011)
changed to per-package environment for module class and object, updated R code and demo accordingly


Modified: pkg/RcppBDT/ChangeLog
===================================================================
--- pkg/RcppBDT/ChangeLog	2011-01-08 15:08:32 UTC (rev 2851)
+++ pkg/RcppBDT/ChangeLog	2011-01-08 18:08:07 UTC (rev 2852)
@@ -1,3 +1,15 @@
+2011-01-08  Dirk Eddelbuettel  <edd at debian.org>
+
+	* src/RcppBDT.cpp: Added two new functions for date of first and last
+	weekday in a given month and year (eg first Friday in Jan 2011)
+
+	* R/bdt.R:
+	  - added function to export core object for access
+	  - changed functions to access core object via per-pack. environment
+	  - added functions for first/last day-of-week in month/year
+
+	* demo/RcppBDT.R: updated to keep in sync with other changes
+	
 2011-01-06  Dirk Eddelbuettel  <edd at dexter>
 
 	* inst/include/RcppBDT.h: Added paragraph about the UseWithString

Modified: pkg/RcppBDT/NAMESPACE
===================================================================
--- pkg/RcppBDT/NAMESPACE	2011-01-08 15:08:32 UTC (rev 2851)
+++ pkg/RcppBDT/NAMESPACE	2011-01-08 18:08:07 UTC (rev 2852)
@@ -1,4 +1,3 @@
 import(Rcpp)
 useDynLib(RcppBDT)
 exportPattern("^[[:alpha:]]+")
-

Modified: pkg/RcppBDT/R/bdt.R
===================================================================
--- pkg/RcppBDT/R/bdt.R	2011-01-08 15:08:32 UTC (rev 2851)
+++ pkg/RcppBDT/R/bdt.R	2011-01-08 18:08:07 UTC (rev 2852)
@@ -18,50 +18,62 @@
 ## You should have received a copy of the GNU General Public License
 ## along with RcppBDT.  If not, see <http://www.gnu.org/licenses/>.
 
+getBDT <- function() {
+    bdtEnv$bdt
+}
+
 getEndOfBizWeek <- function(d = Sys.Date()) {
     stopifnot(inherits(d, "Date"))
-    .bdt$getEndOfBizWeek(d)
+    bdtEnv$bdt$getEndOfBizWeek(d)
 }
 
 getEndOfMonth <- function(d = Sys.Date()) {
     stopifnot(inherits(d, "Date"))
-    .bdt$getEndOfMonth(d)
+    bdtEnv$bdt$getEndOfMonth(d)
 }
 
 getYear <- function(d = Sys.Date()) {
     stopifnot(inherits(d, "Date"))
-    .bdt$fromDate(d)
-    .bdt$getYear()
+    bdtEnv$bdt$fromDate(d)
+    bdtEnv$bdt$getYear()
 }
 
 getMonth <- function(d = Sys.Date()) {
     stopifnot(inherits(d, "Date"))
-    .bdt$fromDate(d)
-    .bdt$getMonth()
+    bdtEnv$bdt$fromDate(d)
+    bdtEnv$bdt$getMonth()
 }
 
 getDay <- function(d = Sys.Date()) {
     stopifnot(inherits(d, "Date"))
-    .bdt$fromDate(d)
-    .bdt$getDay()
+    bdtEnv$bdt$fromDate(d)
+    bdtEnv$bdt$getDay()
 }
 
 getDayOfWeek <- function(d = Sys.Date()) {
     stopifnot(inherits(d, "Date"))
-    .bdt$fromDate(d)
-    .bdt$getDayOfWeek()
+    bdtEnv$bdt$fromDate(d)
+    bdtEnv$bdt$getDayOfWeek()
 }
 
 getDayOfYear <- function(d = Sys.Date()) {
     stopifnot(inherits(d, "Date"))
-    .bdt$fromDate(d)
-    .bdt$getDayOfYear()
+    bdtEnv$bdt$fromDate(d)
+    bdtEnv$bdt$getDayOfYear()
 }
 
 getIMMDate <- function(mon, year) {     # defined as third Wednesday
-    .bdt$getIMMDate(mon, year)
+    bdtEnv$bdt$getIMMDate(mon, year)
 }
 
 getNthDayOfMthWeek <- function(nthday, mthweek, mon, year) {
-    .bdt$getNthDayMthWeek(nthday, mthweek, mon, year)
+    bdtEnv$bdt$getNthDayMthWeek(nthday, mthweek, mon, year)
 }
+
+getLastDayOfWeekInMonth <- function(nthday, mon, year) {
+    bdtEnv$bdt$getLastDayOfWeekInMonth(nthday, mon, year)
+}
+
+getFirstDayOfWeekInMonth <- function(nthday, mon, year) {
+    bdtEnv$bdt$getFirstDayOfWeekInMonth(nthday, mon, year)
+}

Modified: pkg/RcppBDT/R/zzz.R
===================================================================
--- pkg/RcppBDT/R/zzz.R	2011-01-08 15:08:32 UTC (rev 2851)
+++ pkg/RcppBDT/R/zzz.R	2011-01-08 18:08:07 UTC (rev 2852)
@@ -18,9 +18,25 @@
 ## You should have received a copy of the GNU General Public License
 ## along with RcppBDT.  If not, see <http://www.gnu.org/licenses/>.
 
+
+## new environment for our package, local to the package
+bdtEnv <- new.env(parent=emptyenv())
+
 .onLoad <- function (lib, pack) {
+
+    ## we need the methods package
     require(methods, quiet=TRUE, warn=FALSE)
-    .BDTDate <<- Module("bdt")$date
-    .bdt <<- new(.BDTDate)
-    .bdt$setFromUTC()
+
+    ## new environment for our package, stored in global env
+    #.RcppBDTenv <<- new.env(parent=emptyenv())
+
+    ## Create internal variables
+    #.RcppBDTenv$BDTDate <- Module("bdt")$date
+    #.RcppBDTenv$bdt <- new(.RcppBDTenv$BDTDate)
+    #.RcppBDTenv$bdt$setFromUTC()
+
+    bdtEnv$BDTDate <- Module("bdt")$date
+    bdtEnv$bdt <- new(bdtEnv$BDTDate)
+    bdtEnv$bdt$setFromUTC()
+
 }

Modified: pkg/RcppBDT/demo/RcppBDT.R
===================================================================
--- pkg/RcppBDT/demo/RcppBDT.R	2011-01-08 15:08:32 UTC (rev 2851)
+++ pkg/RcppBDT/demo/RcppBDT.R	2011-01-08 18:08:07 UTC (rev 2852)
@@ -3,36 +3,43 @@
 
     require(RcppBDT, quiet=TRUE, warn=FALSE)
 
-    ## this uses the pretty-printing the Rcpp module logic to show
-    ## all available functions and their docstring
+    ## this uses the pretty-printing the Rcpp module logic to show all
+    ## available functions and their docstring (symbol now in per-package env)
     #print(BDTDate)
 
-    cat("Demo of setters\n");
     ## first init a base objects for uses for the functions below
-    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$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")
-    bd$setFirstOfNextMonth(); 		cat("1st of next Month: ", format(bd$getDate()), "\n")
-    bd$addDays(4);                      cat("plus four days   : ", format(bd$getDate()), "\n")
-    bd$subtractDays(3);                 cat("minus three  s   : ", format(bd$getDate()), "\n")
+    ## using the instance stored in an internal environment
+    bd <- getBDT()
 
-    bd$setIMMDate(12, 2010); 		cat("IMM Date Dec 2010: ", format(bd$getDate()), "\n")
-    bd$setEndOfBizWeek();  		cat("end of biz week  : ", format(bd$getDate()), "\n")
+    ## alternative constructors: see R/zzz.R
 
+    cat("Demo of setters\n");
+    ## conversions from string commented out, see inst/include/RcppBDT.h for details
+    ##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$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")
+    bd$setFirstOfNextMonth(); 		cat("1st of next Month : ", format(bd$getDate()), "\n")
+    bd$addDays(4);                      cat("plus four days    : ", format(bd$getDate()), "\n")
+    bd$subtractDays(3);                 cat("minus three days  : ", format(bd$getDate()), "\n")
+
+    bd$setIMMDate(12, 2010); 		cat("IMM Date Dec 2010 : ", format(bd$getDate()), "\n")
+    bd$setEndOfBizWeek();  		cat("end of biz week   : ", format(bd$getDate()), "\n")
+
     cat("\nDemo of getters\n")
     ## now just functions that return values to R
-    cat("From curr. local : ", format(bd$getLocalClock()), "\n")
+    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")
-    cat("IMM Date Dec 2010: ", format(bd$getIMMDate(12, 2010)), "\n")
-    cat("3rd Wed Dec 2010 : ", format(bd$getNthDayMthWeek(3, 3, 12, 2010)), "\n")
+    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")
+
+    cat("\nDemo of functions\n")
+    cat("IMM Date Dec 2010 : ", format(getIMMDate(12, 2010)), "\n")
+    cat("3rd Wed Dec 2010  : ", format(getNthDayOfMthWeek(3, 3, 12, 2010)), "\n")
+    cat("Last Sat Dec 2010 : ", format(getLastDayOfWeekInMonth(6, 12, 2010)), "\n")
+    cat("First Sat Dec 2010: ", format(getFirstDayOfWeekInMonth(6, 12, 2010)), "\n")
 }
 
 demo.RcppBDT()

Modified: pkg/RcppBDT/src/RcppBDT.cpp
===================================================================
--- pkg/RcppBDT/src/RcppBDT.cpp	2011-01-08 15:08:32 UTC (rev 2851)
+++ pkg/RcppBDT/src/RcppBDT.cpp	2011-01-08 18:08:07 UTC (rev 2852)
@@ -115,13 +115,20 @@
 }
 
 Rcpp::Date Date_nthDayOfMthWeek(boost::gregorian::date *d, int nthday, int mthweek, int mon, int year) {
-    //boost::date_time::nth_kday_of_month<boost::gregorian::date>::week_num
-    //nth_dow ans_generator(mthweek, 
-    nth_dow ans_generator(static_cast<boost::date_time::nth_kday_of_month<boost::gregorian::date>::week_num>(mthweek), 
-			  nthday, mon);
+    nth_dow ans_generator(static_cast<boost::date_time::nth_kday_of_month<boost::gregorian::date>::week_num>(mthweek), nthday, mon);
     return Rcpp::wrap(ans_generator.get_date(year));
 }
 
+Rcpp::Date Date_lastDayOfWeekInMonth(boost::gregorian::date *d, int weekday, int mon, int year) {
+    boost::gregorian::last_day_of_the_week_in_month lwdm(weekday, mon);
+    return Rcpp::wrap(lwdm.get_date(year));
+}
+
+Rcpp::Date Date_firstDayOfWeekInMonth(boost::gregorian::date *d, int weekday, int mon, int year) {
+    boost::gregorian::first_day_of_the_week_in_month fwdm(weekday, mon);
+    return Rcpp::wrap(fwdm.get_date(year));
+}
+
 RCPP_MODULE(bdt) {
 
     using namespace boost::gregorian;
@@ -187,6 +194,9 @@
 
     .method("getNthDayMthWeek", &Date_nthDayOfMthWeek, "return nth week's given day-of-week in given month and year")
 
+    .method("getLastDayOfWeekInMonth", &Date_lastDayOfWeekInMonth, "return date of last day-of-week in given month and year")
+    .method("getFirstDayOfWeekInMonth", &Date_firstDayOfWeekInMonth, "return date of last day-of-week in given month and year")
+
     ;
 
 }



More information about the Rcpp-commits mailing list