Decay function (adstock) with pooled models in R

Question

I'm currently using the following code to create a decay (adstock) function of decay rate y:

adstock <- function(x, decay=y) filter(x, decay, method = "recursive")

And this gives the desired result.

However, if I have a pooled set of data, such that each region is grouped together and runs chronologically, the start of the second region has the decay left over from the end of the first. Similarly with the third region etc...

What would be the best way to ensure the first observation of the (n>1) regions remains equal to the original value, but all subsequent values have the decay formula applied?

For example:

Weeks <- c("01/01/2012","08/01/2012","15/01/2012","22/01/2012","29/01/2012","01/01/2012","08/01/2012","15/01/2012","22/01/2012","29/01/2012","01/01/2012","08/01/2012","15/01/2012","22/01/2012","29/01/2012")
Regions <- c("North","North","North","North","North","South","South","South","South","South","West","West","West","West","West")
Variable <- c(5,6,4,8,6,19,20,5,7,8,0,5,4,6,7)
exampledata <- data.frame(Weeks, Regions, Variable)

The new function should run the decay function only for each region. So row 11, 01/01/2012 for the "West" region, should always be zero.

Answer 1

Try the following adstock function:

adstock <-function(data_vector, decay, period, pool_vector=0){  
 data2<-data_vector
 l<-length(data_vector)
#if no pool apply zero to vector
if(length(pool_vector)==1)pool_vector<-rep(0,l)
#outer loop: extract data to decay from observation i
  for( i in 1:l){
    x<-data_vector[i]
#inner loop: apply decay onto following observations after i
    for(j in 1:min(period,l)){
      #constrain decay to same pool (if data is pooled)
      if( pool_vector[i]==pool_vector[min(i+j,l)]){data2[(i+j)]<- data2[(i+j)]+(x*(1-decay)^j)}
    }
  }
#reduce lenth of edited data to equal lenth of innitial data
data2<-data2[1:l]
  return(data2)
}

if you don't use the period decay, just set it as a high number (larger then the number of observations) so if you want a 20% decay by period in your example:

Variable_20D<-adstock(exampledata$Variable,.2,1000,exampledata$Regions)