joshuaulrich / xts

Extensible time series class that provides uniform handling of many R time series classes by extending zoo.
http://joshuaulrich.github.io/xts/
GNU General Public License v2.0
219 stars 71 forks source link

Make diff.xts work when lag is a vector #183

Open joshuaulrich opened 7 years ago

joshuaulrich commented 7 years ago

You can pass a vector of lags to lag.xts():

R> lag(.xts(1:5, 1:5), 1:3)
                    lag1 lag2 lag3
1969-12-31 18:00:01   NA   NA   NA
1969-12-31 18:00:02    1   NA   NA
1969-12-31 18:00:03    2    1   NA
1969-12-31 18:00:04    3    2    1
1969-12-31 18:00:05    4    3    2

You should be able to do the same with diff.xts(), but that currently throws an error:

R> diff(.xts(1:5, 1:5), 1:3)
Error in `-.default`(x, lag.xts(x, k = lag, na.pad = na.pad)) : 
  non-conformable arrays

This might be as easy as coercing x to vector before subtracting the lags, but needs to be tested...

diff --git a/R/lag.xts.R b/R/lag.xts.R
index af30e61..fee149e 100644
--- a/R/lag.xts.R
+++ b/R/lag.xts.R
@@ -113,20 +113,20 @@ diff.xts <- function(x, lag=1, differences=1, arithmetic=TRUE, log=FALSE, na.pad

   if(differences > 1) {
     if(arithmetic && !log) { #log is FALSE or missing
-      x <- x - lag.xts(x, k=lag, na.pad=na.pad)
+      x <- as.vector(x) - lag.xts(x, k=lag, na.pad=na.pad)
     } else {
       if(log) {
-        x <- log(x/lag.xts(x, k=lag, na.pad=na.pad))
-      } else x <- x/lag.xts(x, k=lag, na.pad=na.pad)
+        x <- log(as.vector(x)/lag.xts(x, k=lag, na.pad=na.pad))
+      } else x <- as.vector(x)/lag.xts(x, k=lag, na.pad=na.pad)
     }
     diff(x, lag, differences=differences-1, arithmetic=arithmetic, log=log, na.pad=na.pad, ...)
   } else {
     if(arithmetic && !log) {
-      x - lag.xts(x, k=lag, na.pad=na.pad)
+      as.vector(x) - lag.xts(x, k=lag, na.pad=na.pad)
     } else {
       if(log) {
-        log(x/lag.xts(x, k=lag, na.pad=na.pad))
-      } else x/lag.xts(x, k=lag, na.pad=na.pad)
+        log(as.vector(x)/lag.xts(x, k=lag, na.pad=na.pad))
+      } else as.vector(x)/lag.xts(x, k=lag, na.pad=na.pad)
     }
   }
 }
joshuaulrich commented 7 years ago

Note that you cannot currently do this with diff.zoo in v1.8.0. You get the same error:

diff(zoo(.xts(1:5,1:5)), -(1:2), na.pad=TRUE)
Error in `-.default`(lag(x, k = -lag, ...), x) : non-conformable arrays
In addition: Warning message:
In if (lag > 0) for (i in 1:differences) x <- x - lag(x, k = -lag,  :
  the condition has length > 1 and only the first element will be used