[Xts-commits] r750 - in pkg/xts: R man src

[noreply at r-forge.r-project.org]

Author: jryan
Date: 2012-12-27 16:08:04 +0100 (Thu, 27 Dec 2012)
New Revision: 750

Modified:
   pkg/xts/R/endpoints.R
   pkg/xts/man/endpoints.Rd
   pkg/xts/man/to.period.Rd
   pkg/xts/src/endpoints.c
Log:
o  new (experimental) addlast to endpoints (R,c,Rd).  Currently commented out and non-functioning at the user level.  Has no visible effect yet.
o updated to.period.Rd docs


Modified: pkg/xts/R/endpoints.R
===================================================================
--- pkg/xts/R/endpoints.R	2012-12-23 16:13:33 UTC (rev 749)
+++ pkg/xts/R/endpoints.R	2012-12-27 15:08:04 UTC (rev 750)
@@ -25,6 +25,9 @@
     NR <- length(x)
     x <- xts(, order.by=x)
   } else NR <- NROW(x)
+  addlast <- TRUE  # remove automatic NR last value
+  #if( !is.logical(addlast))
+  #  stop(paste(sQuote("addlast"),"must be logical"))
 
   if(!is.xts(x)) 
     x <- try.xts(x, error='must be either xts-coercible or timeBased')
@@ -48,45 +51,45 @@
   if(on == 'months') {
     #as.integer(c(0, which(diff(posixltindex$mon %/% k + 1) != 0), NR) )
     # x[which(diff(as.POSIXlt(index(x))$mon) != 0)[seq(0,328,12)]]
-    ep <- .Call("endpoints", posixltindex$mon, 1L, 1L, PACKAGE='xts')
+    ep <- .Call("endpoints", posixltindex$mon, 1L, 1L, addlast, PACKAGE='xts')
     if(k > 1)
       ep[seq(1,length(ep),k)]
     else ep
   } else 
   if(on == 'weeks') {
     #as.integer(c(0, which(diff( (.index(x) + (3L * 86400L)) %/% 604800L %/% k + 1) != 0), NR) )
-    .Call("endpoints", .index(x)+3L*86400L, 604800L, k, PACKAGE='xts')
+    .Call("endpoints", .index(x)+3L*86400L, 604800L, k, addlast, PACKAGE='xts')
   } else
   if(on == 'days') {
     #as.integer(c(0, which(diff(.index(x) %/% 86400L %/% k + 1) != 0), NR))
     #as.integer(c(0, which(diff(posixltindex$yday %/% k + 1) != 0), NR))
-    .Call("endpoints", posixltindex$yday, 1L, k, PACKAGE='xts')
+    .Call("endpoints", posixltindex$yday, 1L, k, addlast, PACKAGE='xts')
   } else
   # non-date slicing should be indifferent to TZ and DST, so use math instead
   if(on == 'hours') {
     #c(0, which(diff(as.POSIXlt(index(x))$hour %/% k + 1) != 0), NR) 
     #as.integer(c(0, which(diff(.index(x) %/% 3600L %/% k + 1) != 0), NR))
     #as.integer(c(0, which(diff(posixltindex$hour %/% k + 1) != 0), NR))
-    .Call("endpoints", .index(x), 3600L, k, PACKAGE='xts')
+    .Call("endpoints", .index(x), 3600L, k, addlast, PACKAGE='xts')
   } else
   if(on == 'minutes' || on == 'mins') {
     #c(0, which(diff(as.POSIXlt(index(x))$min %/% k + 1) != 0), NR) 
     #as.integer(c(0, which(diff(.index(x) %/% 60L %/% k + 1) != 0), NR))
     #as.integer(c(0, which(diff(posixltindex$min %/% k + 1) != 0), NR))
-    .Call("endpoints", .index(x), 60L, k, PACKAGE='xts')
+    .Call("endpoints", .index(x), 60L, k, addlast, PACKAGE='xts')
   } else
   if(on == 'seconds' || on == 'secs') {
     #c(0, which(diff(as.POSIXlt(index(x))$sec %/% k + 1) != 0), NR) 
     #as.integer(c(0, which(diff(.index(x) %/%  k + 1) != 0), NR))
-    .Call("endpoints", .index(x), 1L, k, PACKAGE='xts')
+    .Call("endpoints", .index(x), 1L, k, addlast, PACKAGE='xts')
   } else
   if(on == 'milliseconds' || on == 'ms') {
     #as.integer(c(0, which(diff(.index(x)%/%.001%/%k + 1) != 0), NR))
-    .Call("endpoints", .index(x)%/%.001, 1L, k, PACKAGE='xts')
+    .Call("endpoints", .index(x)%/%.001, 1L, k, addlast, PACKAGE='xts')
   } else
   if(on == 'microseconds' || on == 'us') {
     #as.integer(c(0, which(diff(.index(x)%/%.000001%/%k + 1) != 0), NR))
-    .Call("endpoints", .index(x)%/%.000001, 1L, k, PACKAGE='xts')
+    .Call("endpoints", .index(x)%/%.000001, 1L, k, addlast, PACKAGE='xts')
   } else {
     stop('unsupported "on" argument')
   }

Modified: pkg/xts/man/endpoints.Rd
===================================================================
--- pkg/xts/man/endpoints.Rd	2012-12-23 16:13:33 UTC (rev 749)
+++ pkg/xts/man/endpoints.Rd	2012-12-27 15:08:04 UTC (rev 750)
@@ -12,12 +12,15 @@
   \item{x}{ an xts object }
   \item{on}{ the periods endpoints to find as a character string }
   \item{k}{ along every k-th element - see notes }
+%  \item{addlast}{ add last observation regardless of period endpoint }
 }
 \details{
 \code{endpoints} returns a numeric vector corresponding to the
 \emph{last} observation in each period specified by \code{on}, with a
 zero added to the beginning of the vector, and the index of the last
-observation in \code{x} at the end.
+observation in \code{x} at the end. 
+%The last observation may be left
+%off if it does not match a proper \sQuote{endpoint} and \code{addlast=FALSE}.
 
 Valid values for the argument \code{on} include: \dQuote{us} (microseconds),
 \dQuote{microseconds}, \dQuote{ms} (milliseconds),

Modified: pkg/xts/man/to.period.Rd
===================================================================
--- pkg/xts/man/to.period.Rd	2012-12-23 16:13:33 UTC (rev 749)
+++ pkg/xts/man/to.period.Rd	2012-12-27 15:08:04 UTC (rev 750)
@@ -59,6 +59,7 @@
   \item{k}{ number of sub periods to aggregate on (only for minutes and seconds) }
   \item{name}{ override column names }
   \item{OHLC}{ should an OHLC object be returned? (only \code{OHLC=TRUE} currently supported) }
+%  \item{addlast}{ passed to \code{endpoints}. See also. }
   \item{\dots}{ additional arguments }
 }
 \details{

Modified: pkg/xts/src/endpoints.c
===================================================================
--- pkg/xts/src/endpoints.c	2012-12-23 16:13:33 UTC (rev 749)
+++ pkg/xts/src/endpoints.c	2012-12-27 15:08:04 UTC (rev 750)
@@ -2,7 +2,7 @@
 #include <Rinternals.h>
 #include <Rdefines.h>
 
-SEXP endpoints (SEXP _x, SEXP _on, SEXP _k)
+SEXP endpoints (SEXP _x, SEXP _on, SEXP _k, SEXP _addlast /* TRUE */)
 {
   /*
       efficient implementation of:
@@ -59,7 +59,8 @@
       error("unsupported 'x' type");
       break;
   }
-  if(ep[j-1] != nr) { /* protect against endpoint at NR */
+  if(ep[j-1] != nr & asLogical(_addlast)) { /* protect against endpoint at NR */
+/* Rprintf("ep[%i-1] != %i\n", j, nr);  */
     ep[j] = nr;
     j++;
   }