Roll back xts across NA and NULL rows

Question

I need to get the row of data from an an xts object that is n days back, and to skip backwards if the rows n periods back are either absent or populated with NAs.

Here's an example data set.

require(xts)
set.seed(1)

ddf <- data.frame('1m' = rnorm(25), '3m' = rnorm(25))
xxd <- xts(ddf, seq(as.Date('2013-07-27'), length.out = 25, by='day'))
xxd[sample(1:25, 8), ] <- NA
xxd <- xxd[-sample(1:25, 3), ]

The xts object xxd doesn't have a 19 Aug nor 18 Aug and 17 Aug is all NA, so i want to get back 16 Aug. To do this I've hacked together something that gets there using by assigning to an environment, but this doesn't seem very R (or very functional) -- what's the proper way to do this?

rewindX <- function(Xts, dayRew = 1)
{
    flipDates <- function(dayRew)
    {
        assign('newX', Xts[index(last(Xts)) - dayRew], envir = outXenv)
        if(!length(which(!is.na(outXenv$newX)))) 
        {
            dayRew <- dayRew + 1
            flipDates(dayRew)
        }
    }
    outXenv <- new.env(parent = .GlobalEnv)
    flipDates(dayRew)
    return(outXenv$newX)
}

So to rewind, i give rewindX(xxd, 1) and obtain a row.

Here are two examples:

> rewindX(xxd, 1)
                 X1m        X3m
2013-08-16 0.9189774 -0.7074952
> rewindX(xxd, 10)
                  X1m        X3m
2013-08-08 -0.6212406 -0.0593134

your guidance greatly appreciated.

Answer 1

You are looking for na.locf

Generic function for replacing each NA with the most recent non-NA prior to it.

So in you example:

set.seed(1)
ddf <- data.frame('1m' = rnorm(25), '3m' = rnorm(25))
xxd <- xts(ddf, seq(as.Date('2013-07-27'), length.out = 25, by='day'))
xxd[sample(1:25, 8), ] <- NA
xxc <- na.locf(xxd)
xxc["2013-08-16/"]                ## 19 to 17  are equal to 16
                  X1m        X3m
2013-08-16  0.1437715 -0.7767766
2013-08-17  0.1437715 -0.7767766
2013-08-18  0.1437715 -0.7767766
2013-08-19  0.1437715 -0.7767766
2013-08-20 -0.7970895  0.5767188

Answer 2

In the end I went for a variation of the solution suggested in a comment by @agstudy, using findInterval and na.locf.

require(xts)

xd <- xts(rnorm(20), order.by = seq(Sys.Date(), by = 'week', length.out=20))

# objective: rewind back n days, filling in NAs with prior observation
# rewind an xts object by n days
rewindX_fi <- function(Xts, dayRew=1, fillNA = TRUE, last = TRUE, oldDates = TRUE){
    # rewinds an Xts object by dayRew days
    lastFlip <- function(X) {
        if(last) {
            last(X)
        } else X 
    }
    stopifnot(is.xts(Xts))
    newDates <- index(Xts) - dayRew
    rewindRows <- findInterval(newDates, index(Xts))
    Xts_rew <- xts(rep(NA, nrow(Xts)), 
                   order.by = if(oldDates) index(Xts) else newDates)
    nonZeros <- rewindRows[rewindRows > 0]
    Xts_rew[rewindRows > 0,] <- if(fillNA) {
        na.locf(Xts, na.rm = FALSE)[nonZeros,]
    } else {
        Xts_rew <- Xts[nonZeros, ]
    }
    lastFlip(Xts_rew)
}