Calculate the increase / decrease of the cumulative from the local minimum / max.
I am learning R (and its trading problem app via quantmod lib) and regularly browse the community for a lot of new knowledge and tricks here. My impression of R in general and quantmod lib in particular is amazing.
At this point, I need the help of experienced R users. I am using timers loaded via getSymbols and I need to calculate the cumulative rise / drawdown from the local low / high accordingly.
I can solve my problem using FOR loops and also do the necessary modeling in MS Excel, but I want to find a simpler solution that does not require FOR loops and is more "native" in R.
Example. Input data:
20121121 79810
20121122 79100
20121123 80045
20121126 81020
20121127 80200
20121128 81350
20121129 81010
20121130 80550
20121203 80780
20121204 81700
20121205 83705
20121206 83350
20121207 83800
20121210 85385
Result:
CLOSE Cumulative gr/dd
20121121 79810 N/A
20121122 79100 0.58%
20121123 80045 1.55%
20121126 81020 2.37%
20121127 80200 -0.10%
20121128 81350 0.06%
20121129 81010 -0.76%
20121130 80550 -0.82%
20121203 80780 0.73%
20121204 81700 3.78%
20121205 83705 5.19%
20121206 83350 -1.50%
20121207 83800 1.67%
20121210 85385 2.22%
Finally I managed to solve this. Dirk and Darren, thanks a lot for your comments - the "maxdrawdown" feature from the PerformanceAnalytics suite was not exactly what I wanted, but it got me looking at PerformanceAnalytics and doing a search through that site and the web. The findDrawdowns function from the same package, which was close to my need, but was not what I was looking for anyway (this requires updating the last high to start calculating a new drawdown, while I even need local highs and lows to your account). After doing further testing and mistakes, I made my own code that solves my problem without FOR loops. :) Here is the code. As a bonus, it returns a vector with the number of bars of constant rise / fall of the asset. I will be glad if anyone can advise on how to improve it.
library(rusquant)
library(quantmod)
library(tseries)
na.zero <- function(x) {
tmp <- x
tmp[is.na(tmp)] <- 0
return(tmp)
}
my.cumulative.grdd <- function(asset) {
# creating list for temporary data
tmp <- list()
#
# tmp$asset.lag <- na.locf(lag(asset), fromLast=TRUE)
# calculating ROC for the asset + getting ROC shifted by 1 element to the left and to the right
# to compare ROC[i] and ROC[i+1] and ROC[i-1]
tmp$asset.roc <- na.zero(ROC(asset))
tmp$asset.roc.lag <- na.zero(lag(tmp$asset.roc))
tmp$asset.roc.lag1 <- na.locf(lag(tmp$asset.roc, k=-1))
# calculating indices of consequent growth/drawdown waves start and end
tmp$indexfrom <- sapply(index(tmp$asset.roc[sign(tmp$asset.roc) * sign(tmp$asset.roc.lag) <= 0]), function(i) which(index(tmp$asset.roc) == i), simplify=TRUE)
tmp$indexto <- c(sapply(index(tmp$asset.roc[sign(tmp$asset.roc) * sign(tmp$asset.roc.lag1) <= 0]), function(i) which(index(tmp$asset.roc.lag1) == i), simplify=TRUE), length(index(tmp$asset.roc)))
# this is necessary to work around ROC[1] = 1
tmp$indexfrom <- tmp$indexfrom[-2]
tmp$indexto <- tmp$indexto[-1]
# calculating dates of waves start/end based on indices
tmp$datesfrom <- (sapply(tmp$indexfrom, FUN=function(x) format(index(asset)[x])))
tmp$datesto <- (sapply(tmp$indexto, FUN=function(x) format(index(asset)[x])))
tmp$dates <- apply(cbind(tmp$indexfrom, tmp$indexto), 2, FUN=function(x) format(index(asset)[x]))
# merging dates for selection (i.e. "2012-01-02::2012-01-05") and calculation of cumulative product
tmp$txtdates <- paste(tmp$datesfrom, tmp$datesto, sep="::")
# extracting consequent growth/drawdowns
tmp$drawdowns.sequences <- lapply(tmp$txtdates, function(i) tmp$asset.roc[i])
# calculating cumulative products for extracted sub-series
tmp$drawdowns.sequences.cumprods <- lapply(tmp$drawdowns.sequences, function(x) cumprod(1+x)-1)
# generating final result
result <- list()
result$len <- tmp$indexto - tmp$indexfrom + 1
result$cumgrdd <- xts(unlist(tmp$drawdowns.sequences.cumprods), index(tmp$asset.roc))
return(result)
}
# let test
getSymbols("SPY", from="2012-01-01")
spy.cl <- Cl(SPY)
spy.grdd <- my.cumulative.grdd(spy.cl)
spy.grdd
The calculation is already in tseries as a function maxdrawdown
. Here's the start of his example:
mxdrwdR> # Toy example
mxdrwdR> x <- c(1:10, 9:7, 8:14, 13:8, 9:20)
mxdrwdR> mdd <- maxdrawdown(x)
mxdrwdR> mdd
$maxdrawdown
[1] 6
$from
[1] 20
$to
[1] 26
Including that in percentages is pretty straightforward - look at the (short) code of the function itself.
you can use zig zag points to find peaks and valleys and then calculate the percentage increase / decrease. eg
s <- get(getSymbols('goog'))["2012::"]
z <- ZigZag(s[,2:3],10,percent=TRUE)
# 10 in this example is the sensitivity to changes.
# if you want to use closing prices use s instad of s[,2:3]
# extract the extreme points
z <- rbind(z[findPeaks(z)-1],z[findValleys(z)-1])
# calculate the difference
names(z) <- c("zig")
z$PercentChange <- ((z - Lag(z)) / z) * 100
hope this helps
To complement Dirk's answer, the PerformanceAnalytics package has various drawdown options. Here's an excerpt from my code that also shows the height calculation (and the spice ratio as a bonus):
#x is an xts object containing OHLC data
profit=ROC(x$Close)
growth=sum(na.omit(profit)),
equity=exp(sum(na.omit(profit))),
sharpe=as.vector(SharpeRatio.annualized(profit)),
maxDrawdown=maxDrawdown(profit)