CODEWITHSUNDEEP
rdata.table
Ed G
Ed G

Reputation: 822

data.table aggregation with rolling subset on date

I have a set of data along these lines

d1 <- data.frame(
  cat1 = sample(c('a', 'b', 'c'), 100, replace = TRUE),
  date = rep(Sys.Date() - sample(1:100)),
  val = rnorm(100, 50, 5)
  )

require(data.table)

d2 <- data.table(d1)

I can get a daily sum without problem

d2[ , list(.N, sum(val)), by = c("cat1", "date")]

I want to get a sum over 2 days (and then 7 days)

This works:

d.list <- sort(unique(d2$date))
o.list <- list()

for(i in seq_along(d.list)){
  o.list[[i]] <- d2[d2$date >= d.list[i] - 1 & d2$date <= d.list[i], list(.N, sum(val), max(date)), by = c("cat1")]
}

do.call(rbind, o.list)

But slows down on a bigger data set, and doesn't seem to be the best use of data.table.

Is there a more efficient way?

Upvotes: 3

Views: 979

Answers (3)

eddi
eddi

Reputation: 49448

It's very poorly explained in the OP what you want, but this seems to be it:

# generate the [date-1,date] sequences for each date
# adjust length.out to suit your needs
dates = d2[, list(date.seq = seq(date, by = -1, length.out = 2)), by = date]

setkey(dates, date.seq)
setkey(d2, date)

# merge and extract info needed
dates[d2][, list(.N, sum(val), date.seq[.N]), by = list(date, cat1)][, !"date"]
#     cat1 N        V2         V3
#  1:    a 1  38.95774 2014-01-21
#  2:    a 1  38.95774 2014-01-21
#  3:    c 1  55.68445 2014-01-22
#  4:    c 2 102.20806 2014-01-23
#  5:    c 1  46.52361 2014-01-23
# ---                            
#164:    c 1  50.17986 2014-04-27
#165:    b 1  51.43489 2014-04-28
#166:    b 2 100.91982 2014-04-29
#167:    b 1  49.48493 2014-04-29
#168:    c 1  54.93311 2014-04-30

Upvotes: 1

Arun
Arun

Reputation: 118809

This is a bit faster:

First we join for exact matches and obtain the last index (in case of multiple matches)

setkey(d2, cat1, date)
tmp1 = d2[unique(d2, by=key(d2)), which=TRUE, mult="last", allow.cartesian=TRUE]

Then, we construct a copy of d2 and change date to date-1 by reference. Then, we perform a join with roll=-Inf - which is next observation carried backwards. In other words, if there's no exact match, it'll fill the next available value.

d3 = copy(d2)[, date := date-1]
setkey(d3, cat1, date)
tmp2 = d2[unique(d3, by=key(d2)), roll=-Inf, which=TRUE, allow.cartesian=TRUE]

From here, we put together the indices:

idx1 = tmp1-tmp2+1L
idx2 = data.table:::vecseq(tmp2, idx1, sum(idx1))

Subset d2 from idx2 and generate unique ids from idx1:

ans1 = d2[idx2][, grp := rep(seq_along(idx1), idx1)]

Finally aggregate by grp and get the desired result:

ans1 = ans1[, list(cat1=cat1[1L], date=date[.N], 
         N = .N, val=sum(val)), by=grp][, grp:=NULL]
> head(ans1, 10L)
#      cat1       date N       val
#   1:    a 2014-01-20 1  47.69178
#   2:    a 2014-01-25 1  52.01006
#   3:    a 2014-02-01 1  46.82132
#   4:    a 2014-02-06 1  44.62404
#   5:    a 2014-02-11 1  49.63218
#   6:    a 2014-02-14 1  48.80676
#   7:    a 2014-02-22 1  49.27800
#   8:    a 2014-02-23 2  96.17617
#   9:    a 2014-02-26 1  49.20623
#  10:    a 2014-02-28 1  46.72708

The results are identical as in your solution. This one took 0.02 seconds on my laptop, where as yours took 0.58 seconds.

For 7 days, just change:

d3 = copy(d2)[, date := date-1]

to

d3 = copy(d2)[, date := date-6]

Upvotes: 4

Gavin Kelly
Gavin Kelly

Reputation: 2414

Would it be possible to set up a binned date, and then do by on that?

d2$day7 <- as.integer(d2$date) %/% 7
d2[ , list(.N, sum(val)), by = c("cat1", "day7")]

That would give a binned value - if you want a sliding 7 day window, I'd need to think again. Also, for a binned approach, you might need to subtract an offset before doing the %/% if you want to chose the day of the week the groups start at.

Upvotes: 0

Related Questions