Efficient subsetting in R using 2 dataframes

Question

I have a big time series full in one dataframe and a list of timestamps in a different dataframe test. I need to subset full with data points surrounding the timestamps in test. My first instinct (as an R noob) was to write the below, which was wrong

subs <- subset(full,(full$dt>test$dt-i) & (full$dt<test$dt+i))

Looking at the result I realized that R is looping through both the vectors simultaneously giving the wrong result. My option is to write a loop like the below:

subs<-data.frame()
for (j in test$dt) 
  subs <- rbind(subs,subset(full,full$dt>(j-i) & full$dt<(j+i)))

I feel that there might be a better way to do loops and this article implores us to avoid R loops as much as possible. The other reason is I might be hitting up against performance issues as this would be at the heart of an optimization algorithm. Any suggestions from gurus would be greatly appreciated.

EDIT:

Here is some reproducible code that shows the wrong approach as well as the approach that works but could be better.

#create a times series
full <- data.frame(seq(1:200),rnorm(200,0,1))
colnames(full)<-c("dt","val")

#my smaller array of points of interest
test <- data.frame(seq(5,200,by=23))
colnames(test)<-c("dt")

# my range around the points of interset
i<-3 

#the wrong approach
subs <- subset(full,(full$dt>test$dt-i) & (full$dt<test$dt+i))

#this works, but not sure this is the best way to go about it
subs<-data.frame()
for (j in test$dt) 
  subs <- rbind(subs,subset(full,full$dt>(j-i) & full$dt<(j+i)))

EDIT: I updated the values to better reflect my usecase, and I see @mrdwab 's solution pulling ahead unexpectedly and by a wide margin.

I am using benchmark code from @mrdwab and the initialization is as follows:

set.seed(1)

full <- data.frame(
  dt  = 1:15000000,
  val = floor(rnorm(15000000,0,1))
)


test <- data.frame(dt = floor(runif(24,1,15000000)))

i <- 500

The benchmarks are:

       test replications elapsed relative
2    mrdwab            2    1.31  1.00000
3 spacedman            2   69.06 52.71756
1    andrie            2   93.68 71.51145
4  original            2  114.24 87.20611

Totally unexpected. Mind = blown. Can someone please shed some light in this dark corner and enlighten as to what is happening.

Important: As @mrdwab notes below, his solution works only if the vectors are integers. If not, @spacedman has the right solution

Answer 1

one more way using data.tables:

{
temp <- data.table(x=unique(c(full$dt,(test$dt-i),(test$dt+i))),key="x")
temp[,index:=1:nrow(temp)]
startpoints <- temp[J(test$dt-i),index]$index
endpoints <- temp[J(test$dt+i),index]$index
allpoints <- as.vector(mapply(FUN=function(x,y) x:y,x=startpoints,y=endpoints))
setkey(x=temp,index)
ans <- temp[J(allpoints)]$x
}

benchmarks: number of rows in test:9 number of rows in full:10000

       test replications elapsed relative
1 spacedman          100   0.406    1.000
2       new          100   1.179    2.904

number of rows in full:100000

       test replications elapsed relative
2       new          100   2.374    1.000
1 spacedman          100   3.753    1.581

Answer 2

I don't know if it's any more efficient, but I would think you could also do something like this to get what you want:

subs <- apply(test, 1, function(x) c((x-2):(x+2)))
full[which(full$dt %in% subs), ]

I had to adjust your "3" to "2" since x would be included both ways.

Benchmarking (just for fun)

@Spacedman leads the way!

First, the required data and functions.

## Data
set.seed(1)

full <- data.frame(
  dt  = 1:200,
  val = rnorm(200,0,1)
)

test <- data.frame(dt = seq(5,200,by=23))

i <- 3 

## Spacedman's functions
cf = function(l,u){force(l);force(u);function(x){x>l & x<u}}
OR = function(f1,f2){force(f1);force(f2);function(x){f1(x)|f2(x)}}
funs = mapply(cf,test$dt-i,test$dt+i)
anyF = Reduce(OR,funs)

Second, the benchmarking.

## Benchmarking
require(rbenchmark)
benchmark(andrie = do.call(rbind, 
                           lapply(test$dt, 
                                  function(j) full[full$dt > (j-i) & 
                                    full$dt < (j+i), ])),
          mrdwab = {subs <- apply(test, 1, 
                                  function(x) c((x-(i-1)):(x+(i-1))))
                    full[which(full$dt %in% subs), ]},
          spacedman = full[anyF(full$dt),],
          original = {subs <- data.frame()
                      for (j in test$dt) 
                        subs <- rbind(subs, 
                                      subset(full, full$dt > (j-i) & 
                                        full$dt < (j+i)))},
          columns = c("test", "replications", "elapsed", "relative"),
          order = "relative")
#        test replications elapsed  relative
# 3 spacedman          100   0.064  1.000000
# 2    mrdwab          100   0.105  1.640625
# 1    andrie          100   0.520  8.125000
# 4  original          100   1.080 16.875000

Answer 3

Here's a real R way to do it. Functionally. No loops...

Starting with Andrie's example data.

First, an interval comparison function:

> cf = function(l,u){force(l);force(u);function(x){x>l & x<u}}

An OR composition function:

> OR = function(f1,f2){force(f1);force(f2);function(x){f1(x)|f2(x)}}

Now there's sort of a loop here, to construct a list of those comparison functions:

> funs = mapply(cf,test$dt-i,test$dt+i)

Now combine all those into one function:

> anyF = Reduce(OR,funs)

And now we apply the OR composition to our interval testing functions:

> head(full[anyF(full$dt),])
   dt         val
3   3 -0.83562861
4   4  1.59528080
5   5  0.32950777
6   6 -0.82046838
7   7  0.48742905
26 26 -0.05612874

What you've got now is a function of a single variable that tests if the value is in the ranges you defined.

> anyF(1:10)
 [1] FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE

I don't know if this is faster, or better, or what. Someone do some benchmarks!

Answer 4

There is nothing inherently wrong with your code. To achieve your aim, you need a loop of some sort around a vectorised subset operation.

But here is more R-ish way to do it, which might well be faster:

do.call(rbind, 
  lapply(test$dt, function(j)full[full$dt > (j-i) & full$dt < (j+i), ])
)

---

PS: You can significantly simplify your reproducible example:

set.seed(1)

full <- data.frame(
  dt  = 1:200,
  val = rnorm(200,0,1)
)

test <- data.frame(dt = seq(5,200,by=23))

i <- 3 

xx <- do.call(rbind, 
  lapply(test$dt, function(j)full[full$dt > (j-i) & full$dt < (j+i), ])
)

head(xx)
   dt         val
3   3 -0.83562861
4   4  1.59528080
5   5  0.32950777
6   6 -0.82046838
7   7  0.48742905
26 26 -0.05612874