Calculate adstock using data.table - r

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