How to pick best combinations of three columns and apply function by group using data.table in R?

user_3814759 0
Viewed 65

I have the following dt

set.seed(1)
dt <- data.table(expand.grid(c("a","b"),1:2,1:2,c("M","N","O","P","Q")))
dt$perf <- rnorm(nrow(dt),0,.01)
colnames(dt) <- c("ticker","par1","par2","row_names","perf")

I want to pick the best combinations of ticker,par1,par2 that will maximize the cumulative product over row_names. For example the following code does this but is not efficient in a data.table manner which I need it to be:

x <- split(dt,list(dt$ticker,dt$par1,dt$par2))
combn <- setDT(expand.grid(seq(1,length(x),2),seq(2,length(x),2)))
res <- data.table()

for(i in 1:nrow(combn)){
  tmp <- rbindlist(x[as.numeric(combn[i])])
  tmp <- tmp[,list(perf=mean(perf),par1=paste(par1,collapse=","),
                   par2=paste(par2,collapse=",")),by=row_names]
  cumRet <- c(cumRet,tail(cumprod(tmp$perf+1)-1,1))
  res <- rbind(res,data.table(cumRet=cumRet,
                              comb1 = names(x)[as.numeric(combn[i])][1], 
                              comb2=names(x)[as.numeric(combn[i])][2]))
}

res[which.max(cumRet)]
       cumRet comb1 comb2
1: 0.02452314 a.2.2 b.1.1

I know the following code does something similar in a data.table manner. However, it maximizes the combination per period without regard to keeping the ticker,par1,par2 the same across row_names M,N,O,P,Q. I am looking for a solution similar to this but with the logic of my above implementation.

# best possible return
tmp1 <- dt[,list(par1=par1[which.max(perf)],
                par2=par2[which.max(perf)],perf=max(perf)),by=list(ticker,row_names)]
res1 <- tmp1[,list(perf=mean(perf),comb1= paste(c(rbind(par1,par2))[1:.N],collapse="."),
                   comb2=paste(c(rbind(par1,par2))[-1:-.N],collapse=".")),
                    by=row_names]
   row_names        perf comb1 comb2
1:         M 0.010413549   2.2   2.1
2:         N 0.009508122   2.1   2.1
3:         O 0.009314068   1.2   1.1
4:         P 0.008883106   2.2   1.2
5:         Q 0.009316006   2.2   2.2
tail(cumprod(res1$perf+1)-1,1)
[1] 0.0483428

Here is another way of doing this, but it still isn't exactly what I need:

# individual way
 tmp2 <- dt[,list(perf=tail(cumprod(perf+1)-1,1)),by=list(ticker,par1,par2)]
 tmp2 <- tmp2[,list(perf=max(perf),par1=par1[which.max(perf)],
                                      par2=par2[which.max(perf)]),by=ticker]
> tmp2
   ticker        perf par1 par2
1:      a 0.042091594    2    2
2:      b 0.007095708    1    1
> mean(tmp2$perf)
[1] 0.02459365

The result is very similar to my actual calculation res. It gives the correct combinations a.2.2 and b.1.1. But the calculation of the average perf is wrong because averaging then taking the cumulative product is different than taking the cumulative product and averaging.

enter image description hereI need a solution for the former whereas this finds the solution to the latter (it is not always the case that they will be this close or have the same combinations).

Lastly, here is yet another way of doing this but not quite exactly what I need. Below I try the combinations of par1,par2 that maximize my result. Here, however, I use the same par1,par2 on both tickers. I would like to apply the same par1,par2 across row_names but allow different tickers to use varying combinations.

# group way
tmp3 <- dt[,.(perf=mean(perf)),by=.(par1,par2,row_names)]
res3 <- tmp3[,.(perf=tail(cumprod(perf+1)-1,1)),by=.(par1,par2)]
res3[which.max(perf)]
> res3[which.max(perf)]
   par1 par2       perf
1:    2    2 0.01756057
data.table r
1 Answers

This is a more data.table approach! 

dt[,id:= paste(ticker,par1,par2,sep=".")]
setkey(dt,id)
combn <- unique(setDT(expand.grid(unique(dt$id)[1:length(unique(dt$id))/2],
                                 unique(dt$id)[(length(unique(dt$id))/2+1):length(unique(dt$id))])))

f1 <- function(x){

  return(tail(cumprod(dt[x,.(row_names,perf),by=.EACHI]
                      [,.(perf=mean(perf)),by=row_names]$perf+1)-1,1))
}

combn[,perf:=apply(combn,1,f1)]
combn[which.max(perf)]
    Var1  Var2       perf
1: a.2.2 b.1.1 0.02452314

I am not sure how to go through the combn combinations and apply the data.table approach that f1 uses to make it a full data.table approach. But I believe that will make it as fast as possible!

EDIT Here is a almost fully complete data.table approach!

# create new dt that has all combinations and data
res2 <- rbindlist(lapply(1:nrow(combn),function(i) 
                    dt[as.matrix(combn[i])[1,],.(row_names,perf,comb=.GRP*i)]))
res2 <- res2[,.(perf=mean(perf)),by=.(row_names,comb)]
res2 <- res2[,.(perf=tail(cumprod(perf+1)-1,1)),by=comb]
res2[which.max(perf)]
   comb       perf
1:    4 0.02452314
> combn[4]
        Var1  Var2
    1: a.2.2 b.1.1
user_38147590
Related