Calculate adstock using data.table

Question

I have a dataframe as shown:

structure(list(ID = c(1, 1, 1, 1, 2, 2, 2, 2), ColA = c(2, 3, 
4, 5, 2, 3, 4, 5), ColB = c(1, 2, 3, 4, 1, 2, 3, 4), ColA_0.2 = c(2, 
3.4, 4.68, 5.936, 2, 3.4, 4.68, 5.936), ColB_0.2 = c(1, 2.2, 
3.44, 4.688, 1, 2.2, 3.44, 4.688)), class = "data.frame", row.names = c(NA, 
-8L))

What I need ? - For each ID, I want to calculate ColA_ad and ColB_ad. User will pass a parameter 'ad'.

For example - if 'ad' is 0.2 then the values will be calculated as:

• First row - same as ColA (i.e. 2)
• Second row - Add Second row of ColA to 0.2*First row of ColA_ad (i.e. Sum(3,0.2*2)=3.4)
• Third row - Add Third row of ColA to 0.2*second row of ColA_ad (i.e. Sum(4,0.2*3.4)=4.68) and so on.

The same will be calculated for all other columns (here ColB), which can be mentioned in separate vector.

Summary - I would take 0.2 times carry over effect of previous calculated row and add to new row.

The results are displayed in Column ColA_ad and ColB_ad.

As my dataset is very large, I am looking for data.table solution.

Answer 1

Here is a base R solution, where a linear algebra property is applied to speed up your iterative calculation.

• basic idea (taking id = 1 as example)

  • you first construct a low triangluar matrix for mapping from col to col_ad, i.e.,

l <- 0.2**abs(outer(seq(4),seq(4),"-"))
l[upper.tri(l)] <- 0

which gives

> l
      [,1] [,2] [,3] [,4]
[1,] 1.000 0.00  0.0    0
[2,] 0.200 1.00  0.0    0
[3,] 0.040 0.20  1.0    0
[4,] 0.008 0.04  0.2    1

• then you use lover columns col, i.e.,

> l %*% as.matrix(subset(df,ID == 1)[-1])
      ColA  ColB
[1,] 2.000 1.000
[2,] 3.400 2.200
[3,] 4.680 3.440
[4,] 5.936 4.688

• code

ad <- 0.2
col_ad <- do.call(rbind,
                  c(make.row.names = F,
                    lapply(split(df,df$ID), 
                           function(x) {
                             l <- ad**abs(outer(seq(nrow(x)),seq(nrow(x)),"-"))
                             l[upper.tri(l)]<- 0
                             `colnames<-`(data.frame(l%*% as.matrix(x[-1])),paste0(names(x[-1]),"_",ad))
                           }
                    )
                  )
)

dfout <- cbind(df,col_ad)

such that

> dfout
  ID ColA ColB ColA_0.2 ColB_0.2
1  1    2    1    2.000    1.000
2  1    3    2    3.400    2.200
3  1    4    3    4.680    3.440
4  1    5    4    5.936    4.688
5  2    2    1    2.000    1.000
6  2    3    2    3.400    2.200
7  2    4    3    4.680    3.440
8  2    5    4    5.936    4.688

• DATA

df <- structure(list(ID = c(1, 1, 1, 1, 2, 2, 2, 2), ColA = c(2, 3, 
                                                              4, 5, 2, 3, 4, 5), ColB = c(1, 2, 3, 4, 1, 2, 3, 4)), class = "data.frame", row.names = c(NA, 
                                                                                                                                                        -8L))

Answer 2

A non-recursive option:

setDT(DT)[, paste0(cols,"_",ad) := { 
    m <- matrix(unlist(shift(ad^(seq_len(.N)-1L), 0L:(.N-1L), fill = 0)), nrow=.N)
    lapply(.SD, function(x) c(m%*%x))
}, by = ID, .SDcols = cols]

Another recursive option:

library(data.table)
setDT(DT)[, paste0(cols,"_",ad) := {
        a <- 0
        b <- 0
        .SD[, {
            a <- ColA + ad*a        
            b <- ColB + ad*b
            .(a, b)

        }, seq_len(.N)][, (1) := NULL]
    }, 
    by = ID]

output:

   ID ColA ColB ColA_0.2 ColB_0.2
1:  1    2    1    2.000    1.000
2:  1    3    2    3.400    2.200
3:  1    4    3    4.680    3.440
4:  1    5    4    5.936    4.688
5:  2    2    1    2.000    1.000
6:  2    3    2    3.400    2.200
7:  2    4    3    4.680    3.440
8:  2    5    4    5.936    4.688

data:

DT <- structure(list(ID = c(1, 1, 1, 1, 2, 2, 2, 2), ColA = c(2, 3, 
    4, 5, 2, 3, 4, 5), ColB = c(1, 2, 3, 4, 1, 2, 3, 4), ColA_0.2 = c(2, 
        3.4, 4.68, 5.936, 2, 3.4, 4.68, 5.936), ColB_0.2 = c(1, 2.2, 
            3.44, 4.688, 1, 2.2, 3.44, 4.688)), class = "data.frame", row.names = c(NA, 
                -8L))
ad <- 0.2
cols <- c("ColA", "ColB")

Answer 3

Here is one way with data.table using Reduce:

#Columns to apply function to
cols <- names(df)[2:3]

#Create a function to apply 
apply_fun <- function(col, ad) {
   Reduce(function(x, y) sum(y, x * ad), col, accumulate = TRUE)
}

library(data.table)
#Convert dataframe to data.table
setDT(df)
#set ad value
ad <- 0.2
#Apply funnction to each columns of cols
df[, (paste(cols, ad, sep =  "_")) := lapply(.SD, apply_fun, ad), .SDcols = cols, by = ID]

df
#   ID ColA ColB ColA_0.2 ColB_0.2
#1:  1    2    1    2.000    1.000
#2:  1    3    2    3.400    2.200
#3:  1    4    3    4.680    3.440
#4:  1    5    4    5.936    4.688
#5:  2    2    1    2.000    1.000
#6:  2    3    2    3.400    2.200
#7:  2    4    3    4.680    3.440
#8:  2    5    4    5.936    4.688