danielkrizian / danielkrizian/strategery

Add performance summary by period

Open
#16 0 comments 0 reactions 0 assignees View on GitHub
enhance - evaluation
Dominant language
R
Stars
9
Forks
21
PR merge metrics
No merged PRs in 30d

Description

period <- function(from, to, format="%b %y", sep=" - ") {
paste(strftime(from, format=format)
,strftime(to, format=format)
,sep=sep)
}

nperiods <- function(x, ann=NA) {
if(is.na(ann)) {
freq <- if(timeBased(x)) periodicity(as.POSIXct(x))$frequency
ann <- (60_60_24*31) / freq
}
nobs <- length(x)
if(nobs>1){
result <- floor( nobs / ann )
} else result <- NA
as.integer(result)
}
# weeks

difftime(strptime("26.03.2014", format = "%d.%m.%Y"),
strptime("14.01.2013", format = "%d.%m.%Y"),units="weeks")
Time difference of 62.28571 weeks
# months

(as.yearmon(strptime("26.03.2014", format = "%d.%m.%Y"))-
as.yearmon(strptime("14.01.2013", format = "%d.%m.%Y")))*12
[1] 14
# quarters

(as.yearqtr(strptime("26.03.2014", format = "%d.%m.%Y"))-
as.yearqtr(strptime("14.01.2013", format = "%d.%m.%Y")))*4
[1] 4
# years

year(strptime("26.03.2014", format = "%d.%m.%Y"))-
year(strptime("14.01.2013", format = "%d.%m.%Y"))
[1] 1

nmonths <- function(from, to) {
(as.yearmon(as.Date(to))-
as.yearmon(as.Date(from)))*12
}

nyears <- function(x) {
if(is.xts(x))
x <- index(x)
if(is.data.table(x))
if(any("Date" %in% colnames(x)))
x <- as.Date(x[,Date])
x <- as.Date(x)

add <- ifelse(periodicity(x)$scale=='monthly',as.POSIXlt(min(x))$mday,1)
return((as.double(diff(range(x)))+add)/365)
}

compute.time.period <- function (equity=cumprod(1 + R), R=NULL) {
temp <- Sys.getlocale("LC_TIME")
Sys.setlocale(category="LC_TIME", locale="C")
ret <- join( format( range(index(cumprod(1 + R))), '%b %Y'), ' - ')
Sys.setlocale(category="LC_TIME", locale=temp)
return(ret)
}

compute.monthly.returns <- function(equity=cumprod(1 + R), R=NULL){
month.ends = unique(sort(c(1,endpoints(equity, 'months'))))
return( ROC(equity[month.ends, ], type = 'discrete', na.pad=FALSE) )
}

compute.annual.returns <- compute.yearly.returns <- function(equity=cumprod(1 + R), R=NULL){
year.ends = unique(sort(c(1,endpoints(equity, 'years'))))
return( ROC(equity[year.ends, ], type = 'discrete', na.pad=FALSE) )
}

compute.rolling.returns <- function(R, window=12, na.rm=TRUE) {
R <- apply.rolling(R, width=window, FUN=function(x){prod(1 + x) - 1})
if(na.rm) R <- na.omit(R)
return(R)
}

compute.win.months.rate <- function (equity=cumprod(1 + R), R=NULL) {
mret <- compute.monthly.returns(equity)
return( sum(mret >= 0, na.rm = T) / length(mret) )
}
# ' Some Title
# '
# ' @export

compute.win.month.avg.return <- function(equity=cumprod(1 + R), R=NULL) {
mret <- compute.monthly.returns(equity)
return( mean(mret[mret > 0]) )
}

compute.loss.month.avg.return <- function(equity=cumprod(1 + R), R=NULL) {
mret <- compute.monthly.returns(equity)
return( mean(mret[mret < 0]) )
}

compute.best.month <- function(equity=cumprod(1 + R), R=NULL) {
mret <- compute.monthly.returns(equity)
return( max(mret, na.rm = T) )
}

compute.worst.month <- function(equity=cumprod(1 + R), R=NULL) {
mret <- compute.monthly.returns(equity)
return( min(mret, na.rm = T) )
}

compute.win.years.rate <- function (equity=cumprod(1 + R), R=NULL) {
yret <- compute.yearly.returns(equity)
return( sum(yret >= 0, na.rm = T) / length(yret) )
}

compute.best.year <- function(equity=cumprod(1 + R), R=NULL) {
yret <- compute.yearly.returns(equity)
return( max(yret, na.rm = T) )
}

compute.worst.year <- function(equity=cumprod(1 + R), R=NULL) {
yret <- compute.yearly.returns(equity)
return( min(yret, na.rm = T) )
}

compute.win.12m.rate <- function (equity=cumprod(1 + R), R=NULL) {
mret <- compute.monthly.returns(equity)
ret.12m <- as.numeric(compute.rolling.returns(mret, window=12))
return( sum( ret.12m > 0) / length( ret.12m ) )
}

Contributor guide

No contributing guide indexed for this repository

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.