R/d1.alpha.R

In overhuman/d1r: d1r package

## Contains predictors we know of


d1.alpha.add <- function(DT)
{
  # Description -----------------------
  # DT must contain the following fields: hp,lp,cp,op,ts, ticker, date.

  require(TTR)

  d1.alpha.apply.all(DT) 	

}

d1.alpha.apply.all <- function(DT)
{


  # time series factors ------------------------
  # --------------------------------------------
  d1.alpha.apply.TSalpha(DT,aroon,20,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,ATR,14,list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,BBands,20,list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,CCI,20,list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,chaikinVolatility,14,list(date,ticker,hp,lp))
  d1.alpha.apply.TSalpha(DT,CLV,cols=list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,CMF,14,list(date,ticker,hp,lp,cp,ts),T)
  d1.alpha.apply.TSalpha(DT,CMO,14,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,DonchianChannel,14,list(date,ticker,hp,lp))
  #d1.alpha.apply.TSalpha(DT[,.list(date,ticker,cp)],DPO,10)
  d1.alpha.apply.TSalpha(DT,DVI,60,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,EMV,10,list(date,ticker,hp,lp,ts),T)
  #d1.alpha.apply.TSalpha(DT[,.list(date,ticker,cp)],GMMA)
  #d1.alpha.apply.TSalpha(DT,KST,cols=list(date,ticker,cp))
  #d1.alpha.apply.TSalpha(DT,MACD,cols=list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,MFI,14,list(date,ticker,hp,lp,cp,ts),T)
  d1.alpha.apply.TSalpha(DT,OBV,cols=list(date,ticker,cp,ts),usevolume=T)
  #TODO: d1.alpha.apply.TSalpha(DT[,.list(date,ticker,cp)],ROC,1)
  d1.alpha.apply.TSalpha(DT,RSI,14,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,runPercentRank,60,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,SAR,cols=list(date,ticker,hp,lp))
  d1.alpha.apply.TSalpha(DT,SMA,3,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,SMA,10,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,SMA,20,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,EVWMA,10,list(date,ticker,cp,ts),T)
  d1.alpha.apply.TSalpha(DT,stoch,cols=list(date,ticker,hp,lp,cp))
  #d1.alpha.apply.TSalpha(DT,SMI,15,list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,TDI,20,list(date,ticker,cp))
  #d1.alpha.apply.TSalpha(DT,TRIX,20,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,runVar,20,list(date,ticker,cp))
  d1.alpha.apply.TSalpha(DT,ultimateOscillator,cols=list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,VHF,15,list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,volatility,20,list(date,ticker,op,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,WPR,14,list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,williamsAD,cols=list(date,ticker,hp,lp,cp))
  d1.alpha.apply.TSalpha(DT,d1.alpha.liquidityShock,10,cols=list(date,ticker,cp,ts),T)
  #d1.alpha.apply.TSalpha(DT[,.(date,ticker,hp,lp,cp)],,)


  # other factors ------------------------------
  # --------------------------------------------

}



d1.alpha.apply.TSalpha <- function(DT,fun,n,cols=list(date,ticker,cp,ts),usevolume,Klag=2)
{

  # Description ----------------------------------------------------------
  # this standardizes the process of creating time series predictors
  # every predictor function needs to use current information (it is after delayed by 1 day)

  # @param DT: Must have a date column in the first position, a "ticker" column, a volume ("ts") fields, 
  #            and at least one of: High, Low, Close, Open fields,  as required by fun 
  # @param n  | integer |
  # @param fun: a function accepting a time series (xts or matrix/df with date on first position) 
  #             as its first argument, and potentially a lookback window ("n") and usevolume ("usevolume")
  #             argument. It must return a dataframe, datatable or xts
  # @param cols: list of column to use from datatable DT (needed because some functions require a specific order)

  SDT = DT[,eval(parse(text=deparse(substitute(cols)))),with=T] 
  cols = colnames(SDT)
  nameCols = c()
  SDTCols = colnames(SDT)
  colnames(SDT)[1] = "date"
  setorder(SDT,date)
  
  if (!is.function(fun))
    return(DT)
  if (!('ticker'%in%cols))
    stop("Please provide a 'ticker' column")

  if (hasArg(usevolume) & !('ts'%in%cols))
    stop("Please provide a 'ts' volume column")

  if (!timeBased(DT$date))
    stop("First column must contain date or time")






  for (i in SDT[,unique(ticker)]){
    ts = as.xts(SDT[ticker==i,(colnames(SDT)[!colnames(SDT)%in%c("ticker","ts",nameCols)]),with=F])
    if (hasArg(usevolume)&hasArg(n)){
      args = list(ts,n=n,volume=SDT[ticker==i,ts])
    } else if (hasArg(n)&!hasArg(usevolume)){
      args = list(ts,n=n)
    } else if (hasArg(usevolume)&!hasArg(n)){
      args = list(ts,volume=as.xts(SDT[ticker==i,.(date,ts)]))
    } else {
      args = list(ts)
    }
    pred = lag(as.xts(do.call(fun,args)),k=Klag)

    if (nrow(pred)!=nrow(ts))
      return(DT)

    predCols = colnames(pred)
    if (is.null(predCols)){
      counter=0
      for (nc in 1:ncol(pred)) {
	counter=counter+1
	predCols[nc] = paste(substitute(fun),counter,sep="") 
      }
    }

    counter=0
    for (col in predCols){
      if (col %in% SDTCols){
	predCols[which(predCols == col)] = paste(substitute(fun),counter,sep="")
	counter= counter+1
      }
    }
    colnames(pred)=predCols
    nameCols  = colnames(pred)[!colnames(pred)%in%SDT]

    counter=0
    for (c in nameCols){

      if (is.null(c)){
	newCol = paste(substitute(fun),counter,ifelse(hasArg(n),n,""),sep="") 
      } else {
	newCol = paste(c,ifelse(hasArg(n),n,""),sep="")
      }
      DT[ticker==i,(newCol):=eval(parse(text=paste('as.data.table(pred)$',c,sep="")))]
    }
  }
  d1.debug.info("Computed alpha: ",paste(substitute(fun)))
}


d1.alpha.liquidityShock <- function(ts,n,volume){


  if (class(ts)!='xts')
    ts = as.xts(ts)


  if (hasArg(volume)&length(ts)!=length(volume))
    print("TODO")

  num = abs(as.vector(ts))/as.vector(volume)
  illiq = c()
  for (t in 1:length(num)){

    illiq[t] = median(num[max(1,t-n):t])

  }

  return(data.frame(timestamp=index(ts),illiq=illiq))

}