R/FeatureSelection.R

In Bjerring/BEWESO: BEWESO

FeatureSelection <- function(prices,Cno,fees,data.length,OKlist){
  library(corpcor)

  returns <- apply(prices,2,PriceToReturn)
  if(dim(returns)[1] > data.length){
    returns <- returns[(dim(returns)[1] - data.length + 1):dim(returns)[1],]
  }
  data <- data.frame(returns)
  c <- cor.shrink(data,verbose=FALSE)    # correlation
  d <- as.dist(1-c)              # convert correlation to distance
  # (average) apply hirarchical clustering using the linkage function ward to minimize variance in each cluster
  hc <- hclust(d,method ="ward.D2")
  clusters <- cutree(hc, k = Cno)        # Cut hirarchical tree to desired number of instruments

  names(fees) <- colnames(data)
  fees.d <- fees/100/220


 opt.assets <- rep(NA,Cno)
 for(i in 1:Cno){

   c.asset <- which(clusters == i)
   c.store <- rep(0,length(c.asset))
   for(j in 1:length(c.asset)){
     c.store[j] <- OmegaRatio(data[,names(c.asset)[j] ],L=fees.d[names(c.asset)[j]],Rf=0 )
   }

   opt.assets[i] <- names(c.asset)[which(c.store == max(c.store))[1]]
  }

 prime.uni <- OKlist # prime universe, assets always there
 ticker <- opt.assets
 dub.asset <- c(which(duplicated(c(prime.uni,ticker))==TRUE)-length(prime.uni))
 if(length(dub.asset)>0){
   sub.uni <- ticker[ -dub.asset]
 }
  # sub universe, asset universe controlled by screening process, e.g. feature selection
if(length(dub.asset)==0){
  sub.uni <- ticker
}
 opt.assets2 <- c(prime.uni,sub.uni)

 return(opt.assets2)
}