danielkrizian / danielkrizian/strategery
Add more performance/risk metrics
- Dominant language
- R
- Stars
- 9
- Forks
- 21
- PR merge metrics
- No merged PRs in 30d
Description
``` S
#' 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=,
```
Contributor guide
No contributing guide indexed for this repository
Research direction
The issue provides no file path or test entry point. Start by locating the existing compute.* metric functions and the statistics label checklist, then determine which listed metrics are in scope; done means the selected performance and risk metrics are implemented and exposed consistently.
Written by the indexing model from the issue text.
Assessment
- Tech stack
- r
- Domain
- analytics
- Issue type
- Feature
- Difficulty
- 5/5
- Estimated time
- Over a week
- Activity status
- Stale
- Clarity
- Needs clarification
- Newbie friendliness
- 25/100