aggregate time series data faster

Question

I need to calculate some features by distributing them over time and then aggregating as shown below. The code produces the right results but I have roughly 1 million rows of data in my actual set and run time with a code similar to below takes several days of my machine. I'm looking for a more efficient code. I'm not sure with xts or tidyverse packages would be useful here for a speedup. I worked with data.table thinking It would help with speed - maybe it's the wrong choice. Any ideas?

library(data.table)
library(lubridate)

#toy example
rows=1000
set.seed(1)
data=data.table(
  customer.arv = as.POSIXct("2020-01-01 00:00")+dminutes(sample(1:(60*24*7),rows,replace = T)),
  location = sample(1:4,rows,replace = T),
  customer.type = sample(LETTERS[1:5],rows,replace = T),
  charge = sample(seq(50,200,10),rows,replace = T)
  )
data[,':='(customer.dep = customer.arv+dminutes(sample(1:500,rows,replace = T)),
           arv.time.floor = floor_date(customer.arv,"hours"),
           arv.hour = hour(customer.arv))]

#distribute the charge over the length of stay (departure-arrival) and calculate the hourly charge
tot.hourly.charge = function(pass.location,pass.arv.time.floor,pass.customer.type) {
  full.hr.cust = data[customer.arv<=pass.arv.time.floor&customer.dep>=pass.arv.time.floor+dhours(1)&location==pass.location&customer.type==pass.customer.type,sum(charge)]
  partial.hr.cust = data[customer.arv<=pass.arv.time.floor&customer.dep<pass.arv.time.floor+dhours(1)&customer.dep>pass.arv.time.floor&location==pass.location&customer.type==pass.customer.type,sum(charge*minute(customer.dep)/60)]
  return(full.hr.cust+partial.hr.cust)
}

#aggregate
res = data[,.(hourly.charge = tot.hourly.charge(location,arv.time.floor,customer.type)), by=.(location,arv.time.floor,customer.type)]

#sample output
res[order(location,customer.type,arv.time.floor)][1:10,]
    location      arv.time.floor customer.type hourly.charge
 1:        1 2020-01-01 00:00:00             A       0.00000
 2:        1 2020-01-01 03:00:00             A     190.00000
 3:        1 2020-01-01 06:00:00             A     216.66667
 4:        1 2020-01-01 09:00:00             A     100.00000
 5:        1 2020-01-01 12:00:00             A     100.00000
 6:        1 2020-01-01 14:00:00             A      16.66667
 7:        1 2020-01-01 15:00:00             A      50.00000
 8:        1 2020-01-01 18:00:00             A      62.50000
 9:        1 2020-01-01 20:00:00             A       0.00000
10:        1 2020-01-01 22:00:00             A     190.00000

Answer 1

Here is something that you can try first:

data[, arv.time.floor.1h := arv.time.floor + 60*60]

full <- data[data, on=.(location=location, customer.type=customer.type, 
    customer.arv<=arv.time.floor, customer.dep>=arv.time.floor.1h),
    .(charge=x.charge, location, arv.time.floor=i.arv.time.floor, customer.type=i.customer.type)][,
        .(full.hr.cust=sum(charge)), keyby=.(location, customer.type, arv.time.floor)][
            is.na(full.hr.cust), full.hr.cust := 0]

partial <- data[data, on=.(location=location, customer.type=customer.type, 
    customer.arv<=arv.time.floor, customer.dep>arv.time.floor, customer.dep<arv.time.floor.1h),
    .(charge=x.charge, m=minute(x.customer.dep), location, arv.time.floor=i.arv.time.floor, customer.type=i.customer.type)][,
        .(partial.hr.cust=sum(charge * m / 60)), keyby=.(location, customer.type, arv.time.floor)][
            is.na(partial.hr.cust), partial.hr.cust := 0]

ans <- full[partial][, charge := full.hr.cust + partial.hr.cust]

data:

library(data.table)

#toy example
rows=1000
set.seed(1)
data=data.table(
    customer.arv = as.POSIXct("2020-01-01 00:00") + 60 * (sample(1:(60*24*7), rows, replace = TRUE)),
    location = sample(1:4,rows,replace = TRUE),
    customer.type = sample(LETTERS[1:5],rows,replace = TRUE),
    charge = sample(seq(50,200,10),rows,replace = TRUE)
)
data[, `:=`(customer.dep = customer.arv + 60 * sample(1:500,rows,replace = TRUE),
    arv.time.floor = as.POSIXct(round.POSIXt(customer.arv, units="hours")))]
setorder(data, location, customer.type, arv.time.floor)