Conditional Sum Depending on Other Data Frame Columns

Question

Let's say you have a data frame generated by the following commands:

date <- seq(as.Date("2012-09-01"), Sys.Date(), 1)
id <- rep(c("a","b","c","d"), 8)
bdate <- seq(as.Date("2012-08-01"), as.Date("2012-11-01"), 1)[sample(1:32, 32)]

# The end date should be random but greater than the begin date. However, I set it to 15 days later for simplicity.
edate <- bdate + 15

value <- seq(1, 1000, 1)[sample(1:1000, 32)]
dfa <- data.frame(id, value, bdate, edate)
names(dfa) <- c("ID", "Value", "Begin.Date", "End.Date")

The goal is to sum all the observations by ID (i.e., "a", "b", or "c") in the following way:

Date        a   b   c
2012-08-01  XXX YYY ZZZ
2012-08-02  XXX YYY ZZZ
2012-08-03  XXX YYY ZZZ

The values XXX, YYY, and ZZZ represent the sum of all the observations where the date on column "Date" falls between dfa$Begin.Date and dfa$End.Date on the original data frame, for each ID.

My current solution is practically useless for large datasets so I was wondering if there are any faster ways to do it.

My current script:

# Create additional data frame
dfb <- data.frame(seq(as.Date("2012-08-01"), as.Date("2012-11-01"), 1))
names(dfb)[1] <- "Date"

# Variable for unique IDs
nid <- unique(dfa$ID)

# Number of total IDs
tid <- length(nid)

for (i in c(1:tid))
{
sums <- vapply(dfb$Date, function(x)
{
temp <- subset(dfa, dfa$ID == nid[i])
temp <- subset(temp, temp$Begin.Date < x & temp$End.Date > x)
res <- sum(temp$Value)
res
}, FUN.VALUE = 0.1
)
dfb[1+i] <- sums
}

# Change column names to ID
names(dfb) <- c("Date", as.character(nid))

EDIT: I posted an answer below with a more efficient way to do this. However, I accepted Matthew's answer because it set me on the right path.

Answer 1

Thanks to @Matthew Dowle I found out how to do this more efficiently with the data.table package.

# Fire up the bad boy
library(data.table)

# Create the data table with original data
value <- seq(1, 1000, 1)[sample(1:1000, 32)]
dt <- data.table(id, value, bdate, edate)
setnames(dt, names(dt), c("id", "value", "begin", "end"))

# For each pair of id and value, create a row for each day. (i.e., the first line:
# a  928  2012-08-11  2012-08-26
# will now be 15 lines. The first two columns are repeated over 15 different dates.
dt <- dt[, seq(begin[1], (last(end) - 1), by="days"), by = list(id, value)]
setnames(dt, names(dt), c(names(dt)[1:2], "date"))
setkey(dt)

# Sum each pair of id and value over the dates column
dt <- dt[, sum(value), by = list(id, date)]
setnames(dt, names(dt), c(names(dt)[1:2], "value"))
setkey(dt, date, id)

# Define the time span you would like on your final table
timespan <- dt[, seq(as.Date("2012-07-25"), max(date), by = "day")]

# Now just cross reference the time span with your actual data
setkey(dt, id, date)
dt <- dt[CJ(unique(id), timespan), ]
setnames(dt, names(dt), c(names(dt)[1:2], "value"))
setkey(dt, date)

Ta-da!!

Now, to rearrange the table in the order I originally wanted:

Date        a   b   c
2012-08-01  XXX YYY ZZZ
2012-08-02  XXX YYY ZZZ
2012-08-03  XXX YYY ZZZ

Just use dcast from the reshape2 package.

So what do you all think? Awesome, right?

Answer 2

Interesting. It seems very similar to this question :

Splitting irregular time series into regular monthly averages

Does that help? There, as in your question, one trick can be to join to the prevailing begin using roll=TRUE in package data.table. Especially since you stated you have large datasets.

Answer 3

I would do the following. First subset the original data set by checking if the desired date is between Begin.Date and End.Date. Then just use a simple table function to get the frequencies for 'a' through 'd'.

mydate <- as.Date("2012-08-25")  # take Aug 25, 2012 as an example
ind <- (dfa$Begin.Date <= mydate) & (dfa$End.Date >= mydate)
temp <- subset(dfa, ind)
out <- table(temp$ID)

Answer 4

I don't know if this is any faster (have not benchmarked it), and for particularly large data it may create too large an intermediate data set, but I'll present it anyway.

The range of dates considered can be set as well (request based on comment to this answer).

library("plyr")
library("reshape2")

earliest.date <- as.Date("2007-01-01")
latest.date <- as.Date("2012-11-01")

dfa.long <- adply(dfa, 1, function(DF) {
  if(DF$End.Date >= earliest.date & DF$Begin.Date <= latest.date) {
    data.frame(Date=seq(max(DF$Begin.Date, earliest.date), 
                        min(DF$End.Date, latest.date), 
                        1))
  }
})

dfb <- ddply(dfa.long, .(Date, ID), summarise, sum=sum(Value))
dfb <- dcast(dfb, Date~ID, value.var="sum", fill=0)

dfa.long is a data set with each row repeated for each date within the start/end range (constrained to also within the earliest/latest date range). Then it is straightforward to aggregate by date and ID and use dcast from reshape2 to turn it into the wide format you wanted.