[Xts-commits] r768 - in pkg/xts: . R src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Feb 3 05:59:40 CET 2013


Author: jryan
Date: 2013-02-03 05:59:38 +0100 (Sun, 03 Feb 2013)
New Revision: 768

Modified:
   pkg/xts/DESCRIPTION
   pkg/xts/R/index.R
   pkg/xts/R/na.R
   pkg/xts/src/diff.c
   pkg/xts/src/leadingNA.c
   pkg/xts/src/xts.h
Log:
o  new _limit argument to internal na_locf code. Once enabled
   this will restrict NA fill to a maximum number of values to
   carry forward[backward]. Still testing.
o  fixed xts.h, na.R to reflect changes above
o  diff now includes a few more comments
o  index<- now correctly handles UTC fixed Date objects when
   resetting index values.  .index<- version behaved correctly AFAICT


Modified: pkg/xts/DESCRIPTION
===================================================================
--- pkg/xts/DESCRIPTION	2013-01-28 03:57:04 UTC (rev 767)
+++ pkg/xts/DESCRIPTION	2013-02-03 04:59:38 UTC (rev 768)
@@ -1,7 +1,7 @@
 Package: xts
 Type: Package
 Title: eXtensible Time Series
-Version: 0.9-3.1
+Version: 0.9-3.2
 Date: 2013-01-14
 Author: Jeffrey A. Ryan, Joshua M. Ulrich
 Depends: zoo (>= 1.7-2)

Modified: pkg/xts/R/index.R
===================================================================
--- pkg/xts/R/index.R	2013-01-28 03:57:04 UTC (rev 767)
+++ pkg/xts/R/index.R	2013-02-03 04:59:38 UTC (rev 768)
@@ -70,10 +70,13 @@
                'index type of class',sQuote(class(value))))
 
   # set index to the numeric value of the desired index class
-  attr(x, 'index') <- as.numeric(as.POSIXct(value))
+  if(inherits(value,"Date"))
+    attr(x, 'index') <- structure(unclass(value)*86400, tclass="Date", tzone="UTC")
+  else attr(x, 'index') <- as.numeric(as.POSIXct(value))
 
-  # set the .indexCLASS attribute to the end-user specified class
+  # set the .indexCLASS/tclass attribute to the end-user specified class
   attr(x, '.indexCLASS') <- class(value)
+  attr(.index(x), '.tclass') <- class(value)
   return(x)
 }
 

Modified: pkg/xts/R/na.R
===================================================================
--- pkg/xts/R/na.R	2013-01-28 03:57:04 UTC (rev 767)
+++ pkg/xts/R/na.R	2013-02-03 04:59:38 UTC (rev 768)
@@ -100,11 +100,11 @@
     if(dim(object)[2] > 1) {
       x <- object
       for(n in 1:NCOL(object))
-        x[,n] <- .Call('na_locf', object[,n], fromLast, maxgap, PACKAGE='xts')
+        x[,n] <- .Call('na_locf', object[,n], fromLast, maxgap, Inf, PACKAGE='xts')
       #.xts(apply(object, 2, function(x) .Call('na_locf', x, fromLast, maxgap, PACKAGE='xts')),
       #     .index(object), tzone=indexTZ(object), .indexCLASS=indexClass(object))
     } else {
-      x <- .Call("na_locf", object, fromLast, maxgap, PACKAGE="xts")
+      x <- .Call("na_locf", object, fromLast, maxgap, Inf, PACKAGE="xts")
     }
     if(na.rm) {
       return(structure(na.omit(x),na.action=NULL))

Modified: pkg/xts/src/diff.c
===================================================================
--- pkg/xts/src/diff.c	2013-01-28 03:57:04 UTC (rev 767)
+++ pkg/xts/src/diff.c	2013-02-03 04:59:38 UTC (rev 768)
@@ -7,7 +7,7 @@
 #
 #   This program 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 3 of the License, or
+#   the Free Software Foundation, either version 2 of the License, or
 #   (at your option) any later version.
 #
 #   This program is distributed in the hope that it will be useful,
@@ -517,11 +517,19 @@
 }
 
 SEXP lag_xts (SEXP x, SEXP _k, SEXP _pad) {
+  /* this will eventually revert to NOT changing R default behaviors 
+     for now it uses the 'standard' convention adopted by xts        */
+
   int k = INTEGER(_k)[0]*-1; /* change zoo default negative handling */
   return zoo_lag (x, ScalarInteger(k), _pad);
 }
 
 SEXP lagts_xts (SEXP x, SEXP _k, SEXP _pad) {
+  /* this will use positive values of lag for carrying forward observations
+ 
+     i.e. y = lagts(x, 1) is y(t) = x(t-1)
+  */
+
   int k = INTEGER(_k)[0]*-1; /* change zoo default negative handling */
   return zoo_lag (x, ScalarInteger(k), _pad);
 }

Modified: pkg/xts/src/leadingNA.c
===================================================================
--- pkg/xts/src/leadingNA.c	2013-01-28 03:57:04 UTC (rev 767)
+++ pkg/xts/src/leadingNA.c	2013-02-03 04:59:38 UTC (rev 768)
@@ -127,14 +127,14 @@
   return(first);
 }
 
-SEXP na_locf (SEXP x, SEXP fromLast, SEXP _maxgap)
+SEXP na_locf (SEXP x, SEXP fromLast, SEXP _maxgap, SEXP _limit)
 {
   /* only works on univariate data         *
    * of type LGLSXP, INTSXP and REALSXP.   */
   SEXP result;
 
   int i, ii, nr, _first, P=0;
-  double gap, maxgap;
+  double gap, maxgap, limit;
   _first = firstNonNA(x);
 
   if(_first == nrows(x))
@@ -148,6 +148,7 @@
 
   nr = nrows(x);
   maxgap = asReal(coerceVector(_maxgap,REALSXP));
+  limit  = asReal(coerceVector(_limit ,REALSXP));
   gap = 0;
 
   PROTECT(result = allocVector(TYPEOF(x), nrows(x))); P++;
@@ -198,7 +199,8 @@
         for(i=_first+1; i<nr; i++) {
           int_result[i] = int_x[i];
           if(int_result[i] == NA_INTEGER) {
-            int_result[i] = int_result[i-1];
+            if(limit > gap)
+              int_result[i] = int_result[i-1];
             gap++;
           } else {
             if((int)gap > (int)maxgap) {
@@ -220,7 +222,8 @@
         for(i=nr-2; i>=0; i--) {
           int_result[i] = int_x[i];
           if(int_result[i] == NA_INTEGER) {
-            int_result[i] = int_result[i+1];
+            if(limit > gap)
+              int_result[i] = int_result[i+1];
             gap++;
           } else {
             if((int)gap > (int)maxgap) {
@@ -247,8 +250,9 @@
         }
         for(i=_first+1; i<nr; i++) {
           real_result[i] = real_x[i];
-          if(ISNA(real_result[i]) || ISNAN(real_result[i])) {
-            real_result[i] = real_result[i-1];
+          if( ISNA(real_result[i]) || ISNAN(real_result[i])) {
+            if(limit > gap)
+              real_result[i] = real_result[i-1];
             gap++;
           } else {
             if((int)gap > (int)maxgap) {
@@ -269,7 +273,8 @@
         for(i=nr-2; i>=0; i--) {
           real_result[i] = real_x[i];
           if(ISNA(real_result[i]) || ISNAN(real_result[i])) {
-            real_result[i] = real_result[i+1];
+            if(limit > gap)
+              real_result[i] = real_result[i+1];
             gap++;
           } else {
             if((int)gap > (int)maxgap) {

Modified: pkg/xts/src/xts.h
===================================================================
--- pkg/xts/src/xts.h	2013-01-28 03:57:04 UTC (rev 767)
+++ pkg/xts/src/xts.h	2013-02-03 04:59:38 UTC (rev 768)
@@ -81,7 +81,7 @@
 SEXP do_merge_xts(SEXP x, SEXP y, SEXP all, SEXP fill, SEXP retclass, SEXP colnames, 
                   SEXP suffixes, SEXP retside, SEXP env, int coerce);
 SEXP na_omit_xts(SEXP x);
-SEXP na_locf(SEXP x, SEXP fromlast, SEXP maxgap);
+SEXP na_locf(SEXP x, SEXP fromlast, SEXP _maxgap, SEXP _limit);
 
 SEXP tryXts(SEXP x);
 



More information about the Xts-commits mailing list