danielkrizian / danielkrizian/strategery
Add performance summary by period
- 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.