Open CPU is a great project. Few months back, I wrote a function for plotting a moving window of the market average correlation. Jeroen C.L. Ooms was nice enough to upload it to their server. Something is now changed. Quotes now return as a character class, as oppose to numeric. This messes up the function and the plot does not renders. I don’t wish to disturb Jeroen C.L. Ooms again with the correction for the code (despite his kind replies in the past). This problem creates the opportunity to look at the glistening “Shiny” package. I used it to (quickly..) build an app for the plot. You can now view a live correlation plot with the moving window of your choice. Live, as the app requests current market data. The width of the window for correlation calculation is given as an input parameter.
You can find the plot here.
The code, (let’s be honest.. this is the most interesting part..), is as follows:
Server:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
library(shiny) if (!require(quantmod)) { stop("This app requires the quantmod package. To install it, run 'install.packages(\"quantmod\")'.\n") } # Download data # library(quantmod) symetf = c('XLY','XLP','XLE','XLF','XLV','XLI','XLB','XLK','XLU','SPY') end<- format(Sys.Date(),"%Y-%m-%d") start<-format(Sys.Date() - (3*365),"%Y-%m-%d") # 3 years of data dat0 = (getSymbols(symetf[1], src="google", from=start, to=end, ascii = TRUE, auto.assign = F, warnings = FALSE,symbol.lookup = F)) n = NROW(dat0) ; l = length(symetf) dat = array(dim = c(n,NCOL(dat0),l)) ; ret = matrix(nrow = n, ncol = l) for (i in 1:l){ dat0 = getSymbols(symetf[i], src="google", from=start, to=end, auto.assign = F,warnings = FALSE,symbol.lookup = F) dat[1:n,4,i] <- as.numeric(dat0[,4]) #### ret[2:n,i] = dat[2:n,4,i]/dat[1:(n-1),4,i] - 1 } shinyServer(function(input, output) { RollCorr = function(h){ rolcor = NULL for (i in 2:(n-h)){ rolcor[i+h] = mean(cor(ret[i:(i+h),])[lower.tri(cor(ret[i:(i+h),]))]) # just the rolling average correlation } par(mfrow = c(2,1), bg = gray(1/1.05), bty ="n", fg = gray(0.1) ,font.lab = 6, font.axis = 6, font.main = 6, col.axis = gray(0.3) , col.lab = gray(0.1) , pch = 21, tck = -0.02, cex.lab = 1.5,cex.main = 2, mar = c(5, 4, 4, 2) + 0.4) lwd1 = 2.5 plot(rolcor~index(dat0), ty = "l",lwd = lwd1, xlab = "Time",ylim = c(0,1), ylab = "Average Correlation", main = "Rolling Correlation") plot(dat[1:n,4,10]~index(dat0), ty = "l", lwd = lwd1, xlab = "Time", ylab = "SPY Price Level",main ="SPY Price Level") } output$Corrplot <- reactivePlot(function() { RollCorr(h = input$numweeks*5) # 5 bussiness days in a week }) }) |
UI:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
library(shiny) shinyUI(pageWithSidebar( headerPanel(title=HTML("Rolling Correlation - Most Recent 3 Years")), sidebarPanel( numericInput("numweeks", "Number of weeks for moving window calculation:", value = 1, min = 1, max = 150, step = 1) ), mainPanel( h3(textOutput("Live Rolling Correlation Plot")), plotOutput("Corrplot", width = "100%", height = "700px") ) )) |
You still here?
Few more comments:
(1)
The app itself is located on the RStudio server. Yes, they are cool like that, just apply and get an email back with clear instructions an ape can follow. (Not to bad mouth any apes out there.. each with its own set of skills.)
(2)
A bit on the actual plot:
It is a time series. Every point represents the average correlation between 10 ETF’s that cover different major market sectors. (more here).
As you increase the width of the window, you will observe the series become smoother. This is natural. I also note that even when the width is 12 weeks, the series still fluctuate between 0.6 and 0.9. Also, it is said that correlation increases with market draw-downs. I think this is most easily seen for “Number of weeks for moving window calculation: 4”. Remember the calculation of correlation is done over the most recent 4 weeks and is not forward looking, so account for this lag when you look at SPY price level in the bottom panel.
