From noreply at r-forge.r-project.org Sun Feb 3 05:59:40 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 3 Feb 2013 05:59:40 +0100 (CET) Subject: [Xts-commits] r768 - in pkg/xts: . R src Message-ID: <20130203045941.4C16A184B1E@r-forge.r-project.org> 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 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 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);