Add more performance/risk metrics

[danielkrizian]

#' Sortino Ratio
#' TODO: currently supports only constant MAR
#' @export
compute.sortino <- function(R, MAR=0) {
  f = compute.annual.factor(R)
  R = coredata(R)

  if(is.null(dim(MAR)))
    excess.R <- R - MAR
  else (stop("MAR vector not yet supported"))

  MARlabel <- paste(round(mean(MAR) * 100, 3), "%)", sep = "")

  return( sqrt(f) * mean(excess.R) / compute.downside.deviation(R, MAR=MAR) )
}

#' Equity curve versus moving average (old mom)
#' 
#' @export
compute.momentum <- function(
  R
  ,equity=equity.index(R, continuous=F, base=1, na.fill=list(0,0,0))
  ,lag.n=0
  ,smooth.n=1
)
{
  if(length(equity) < smooth.n)
    return(as.numeric(NA))
  ma <- lag(SMA(equity, n=smooth.n),k=lag.n, na.pad=F)
  last(equity) / last(ma) - 1
}

#' Compute Market-Timing Premium
#' 
#' Excess return over long/short position bias adjusted market benchmark
#' @param R vector of strategy returns
#' @param pos vector of strategy positions
#' @param Rb vector of raw market returns
#' @export
compute.mean.excess.return <- function(
  R,
  pos,
  Rb
){  
  mean(R-Rb * pos)
}

#' Some Title
#' 
#' @export
compute.edge <- function(
  strategy,
  pars,
  dates=NULL,
  portfolio=Test(strategy,pars, dates=dates, details=F, returns=F)
){
  rObs <- Returns(portfolio, type="periods", reduce=T, refresh=F)
  n <- NROW(rObs)
  if(n<2)
    return(0.5)
  rBench = Returns(portfolio=Benchmark(type="Random", portfolio=portfolio),reduce=F)
  muObs <- mean(rObs,na.rm=T)
  mu <- mean(rBench,na.rm=T)
  s <- sd(rObs, na.rm=T)
  statistic = (muObs - mu) / (s / sqrt(n))
  p.value <- pnorm(-statistic)
  return(p.value)
}

compute.twr <- function(equity=cumprod(1 + R), R=NULL) 
  return(compute.total.return(equity))

compute.downside.deviation <- function (R, MAR = 0, method = c("full", "subset")) {
  method = method[1]
  R <- as.vector(R)
  if (!is.null(dim(MAR)))
    MAR = mean(checkData(MAR, method = "vector"))
  r = subset(R, R < MAR)
  switch(method, full = {
    len = length(R)
  }, subset = {
    len = length(r)
  })

  #     if (!is.null(dim(MAR))) MAR = as.numeric(Return.annualized(MAR,geometric=FALSE))
  #     MARlabel <- paste("Downside Deviation (MAR = ", round(MAR * 100, 1), "%)", sep = "")

  return(sqrt(sum((r - MAR)^2)/len))
}

#' Kestner Ratio
#' 
#' @export
compute.kestner <- compute.kratio <- function(equity=cumprod(1 + R), R=NULL, adjust.n=F) {
  # adjust.n - divide by number of datapoints
  # adjust.n discussion (Zephyr K-ratio): 
  # http://s3.amazonaws.com/zanran_storage/www.styleadvisor.com/ContentPages/2449998087.pdf
  # formulas: http://www.financialwebring.org/gummy-stuff/K-Ratio.htm
  # amibroker implementation: http://www.mail-archive.com/amibroker@yahoogroups.com/msg39841.html
  n = nrow(equity)
  xt = 1:n
  log.e = coredata(log(equity))
  mod = summary(lm( log.e ~ xt ))
  slope = mod$coefficients['xt', 'Estimate']
  slope.stde = mod$coefficients['xt', 'Std. Error']
  k = slope/(slope.stde)
  if(adjust.n) k = k / n
  return(k)
}

#' Monte Carlo drawdown
#' 
#' @export
compute.MCDD <- function(R=wf$R[wf$R!=0], conf=.95, samples=1000, parallel=F){
  require(np)
  require(boot)
  R <- R[R!=0]

  if(any(is.na(R)))
    stop("Clean NAs in R input in compute.MCDD")

  if(parallel){
    parallel="snow"
    ncpus=detectCores()
    cl=createCluster(parVar=c("Equity","string.range"), packages="xts")
  } else {
    parallel="no"
    ncpus=1
    cl=NULL
  }
  block.length <- b.star(R,round=T)[1] # for "geom", mean of blocks dist.

  bootstrap <- tsboot(tseries=R
                      ,statistic=compute.max.drawdown
                      ,R=samples
                      ,sim="geom"  #"geom"
                      ,l=block.length
                      ,parallel=parallel
                      ,ncpus=ncpus
                      ,cl=cl)
  MCDD <- quantile(bootstrap$t, probs=1-conf)
  names(MCDD) <- NULL
  return (MCDD)
}

#' Time in market
#' 
#' @export
compute.percent.in.market <- function(pos=bt$pos) {
  # Calculates percentage time the strategy signals position in the market.
  # Args:
  #   pos: position matrix, where columns are symbols, rows are positions for the following period, coded as one of the values: {NA, -1, 0, 1}
  # Returns:
  #   percentage of observations that are non-zero and non-NA. Columnnames are symbols.
  if(ncol(pos)>1) stop("compute.percent.in.market not ready for multi-column b$pos")
  sum(pos != 0, na.rm=TRUE) / nrow(pos)
}

#' RINA ratio
#' 
#' total net profit, divides it by the average drawdown and divides it again by the percent time in the market.
#' http://www.bigmiketrading.com/psychology-money-management/11594-evaluation-discussion-performance-ratios.html#post129146
#' @export
compute.rina <- function(R) {

}

#' The e-ratio quantifies the edge by calculating the overall amount trades go in your favor versus the overall amount trades go against you.
#' http://www.automated-trading-system.com/e-ratio-trading-edge/
eratio <- function() {}

Checklist:
statistics[['cagr']] <- c("CAGR","Annualized Return")
statistics[['excess']] <- c("Excess Return")
statistics[['twr']] <- c("TWR")
statistics[['total.return']] <- c('Total Return')
statistics[['sigma']] <- c("Volatility","Annualized StDev")
statistics[['max.drawdown']] <- c("Max Drawdown","Max Daily Drawdown","Max DD")
statistics[['avg.drawdown']] <- c('Average Drawdown')
statistics[['avg.drawdown.length']] <- c('Avg Drawdown Length')
statistics[["sharpe"]] <- c("Sharpe", "Sharpe Ratio")
statistics[["sortino"]] <- c("Sortino", "Sortino Ratio")
statistics[["dvr"]] <- c("DVR")
statistics[["mar"]] <- c("MAR")
statistics[["trades.per.year"]] <- c('Trades Per Year','Avg Trades Per Year')
statistics[['percent.in.market']] <- c('Time In Market','Percent In Market','Exposure')

statistics[['win.rate']] <- c("Win Rate","Hit Ratio", "Trade Winning %")
statistics[['avg.pnl']] <-
  c("Average Trade","Average P&L","Avg P&L","Average Trade P&L", "Avg Trade P&L", "Avg Trade")
statistics[['win.avg.pnl']]<-c("Average Win")
statistics[['loss.avg.pnl']]<-c("Average Loss")
statistics[['win.loss.ratio']]<-c("Win/Loss Ratio", "W/L Ratio")
statistics[['best.trade']]<-c("Best Trade")
statistics[['worst.trade']]<-c("Worst Trade")
statistics[['avg.days.in.trade']]<-c('Avg Days in Trade')
statistics[["ntrades"]] <- c("Trades")
statistics[["expectancy"]] <- c("Expectancy")
statistics[["profit.factor"]] <- c("Profit Factor")

statistics[["win.months.rate"]] <- c('% Winning Months')
statistics[["win.month.avg.return"]] <- c('Average Winning Month')
statistics[["loss.month.avg.return"]] <- c('Average Losing Month')
statistics[["best.month"]] <- c('Best Month')
statistics[["worst.month"]] <- c('Worst Month')

statistics[["win.years.rate"]] <- c('% Winning Years')
statistics[["best.year"]] <- c('Best Year')
statistics[["worst.year"]] <- c('Worst Year')
statistics[["win.12m.rate"]] <- c('Positive 12 Month Periods')
statistics[["time.period"]] <- c('Time Period')

out$win.len = mean( tlen[ tpnl > 0 ])
out$loss.len = mean( tlen[ tpnl < 0 ])
out$Win.Percent.Day = sum(bt$ret > 0, na.rm = T) / len(bt$ret)
out$Best.Day = bt$best
out$Worst.Day = bt$worst

'Skew'=,
'Kurt'=,
CAGR.MaxDD=,
U.Capture=,
D.Capture=,
U.Number=,
D.Number=,
U.Pctge=,
D.Pctge=,