Rolling Correlation Template

Graph

Annual Distributions

Data

The data can be searched and sorted. In case you want to find the highest values in a particular column, click on the arrows next to its name. The data can be downloaded by clicking on the link below the table.

Download Data as csv

Source code

knitr::opts_chunk$set(echo = TRUE)
library(quantmod)
library(PerformanceAnalytics)
library(tidyverse)
library(xts)
library(ggthemes)
library(lubridate)
library(ggridges)
library(plotly)
library(DT)
library(kableExtra)
getSymbols('MSFT', from = '2015-01-01')
getSymbols('GS', from = '2015-01-01')
Ra <- GS[, 4]
Rb <- MSFT[, 4]

##############################################################################################
## Code for the rolling_correlation function   
## The function is based on the 'chart.RollingCorrelation' function from 'PerformanceAnalytics'
##############################################################################################

rolling_correlation <- function (Ra, Rb, width = 60, xaxis = TRUE, 
                     legend.loc = NULL, 
                     colorset = (1:12), ..., fill = NA) 
  
{
  Ra = checkData(Ra)
  Rb = checkData(Rb)
  columns.a = ncol(Ra)
  columns.b = ncol(Rb)
  columnnames.a = colnames(Ra)
  columnnames.b = colnames(Rb)
  for (column.a in 1:columns.a) {
      for (column.b in 1:columns.b) {
      merged.assets = merge(Ra[, column.a, drop = FALSE], 
                            Rb[, column.b, drop = FALSE])
      
      column.calc = rollapply(na.omit(merged.assets[, , 
                                                    drop = FALSE]), 
                              width = width, FUN = function(x) 
                                cor(x[,1, drop = FALSE], x[, 2, drop = FALSE]), 
                              by = 1, 
                              by.column = FALSE, fill = fill, align = "right")
      column.calc.tmp = xts(column.calc)
      colnames(column.calc.tmp) = paste(columnnames.a[column.a], 
                                        columnnames.b[column.b], sep = " to ")
      column.calc = xts(column.calc.tmp, order.by = time(column.calc))
      if (column.a == 1 & column.b == 1) 
          Result.calc = column.calc
      else Result.calc = merge(Result.calc, column.calc)
      }
    
    colnames(Result.calc)[1] <- 'rolling_correlation'
    correlation_xts <<- Result.calc
   
    # lose the n empty rows part of the initialization,
    # where n is equal to the width of the rolling function
    # Assuming that the data is complete;
    correlation_xts <<- correlation_xts[!is.na(correlation_xts)]
    # 
    
  }
  
  chart.TimeSeries(Result.calc, xaxis = xaxis, colorset = colorset, 
                   legend.loc = legend.loc, main = 'Rolling Correlation' ,
                   ylim = c(-1, 1), ...)
  
# Convert the time series object into a data frame  
correlation_df <- fortify.zoo(correlation_xts)

f <- list(family = "sans serif", size = 19, color = "#000000")

label.x <- list(
  title = "Date",
  titlefont = f, 
  domain = c(0.1, 2)
)
label.y <- list(
  title = "Rolling Correlation",
  titlefont = f)


 ##### Test for multiple outputs with the plotly button
correlation_df2 <- correlation_df %>% 
                   mutate (column = cos(exp(rolling_correlation)))
 
plot_ly(correlation_df2, x = ~Index, y = ~rolling_correlation, 
         mode = "lines", type = "scatter", 
         name = "A", visible = TRUE) %>%
   layout(
     title = "Rolling Correlation",
     xaxis = label.x,
     yaxis = label.y, 
     updatemenus = list( 
       list(
         y = 0.92,
         buttons = list(
           list(method = "restyle",
                args = list("y", list(correlation_df2$rolling_correlation)),  # put it in a list
                label = "6-Month Rolling"),
           list(method = "restyle",
                args = list("y", list(correlation_df2$column)),  # put it in a list
                label = "9-Month Rolling")))))  
 
}


## Call the function to produce the plot and the datasets
rolling_correlation(Ra, Rb, width = 50)
rolling_correlation(Ra, Rb, width = 50)


correlation_df <- fortify.zoo(correlation_xts)
correlation_df <-  correlation_df %>% 
            mutate(year = as.factor(year(Index)))

subtitle <- paste0('Period: ', min(year(correlation_df$Index)), ' - ', max(year(correlation_df$Index)))

###############################################
### Code for the Distribution Graphs  #########
###############################################

ggplot(correlation_df, aes(x = rolling_correlation, 
                           y = year, 
                     height = ..density..))+
        geom_density_ridges(stat = "density_ridges", col = "black", 
                            fill = "blue", alpha = 0.7)  +
        theme_gdocs(base_size = 13) +
        theme(panel.border = element_blank())+
        xlab("Rolling Correlation grouped by Year") + 
        ylab("Year")+
        ggtitle("Distribution of Rolling Correlation ", 
                subtitle = subtitle)



correlation_df$rolling_correlation <- round(correlation_df$rolling_correlation, 3)
colnames(correlation_df) <- c('Date', 'Rolling Correlation')

datatable(correlation_df[, c(1, 2)], options = list(
         pageLength = 10, autoWidth = TRUE), 
         filter = 'top', width = 500, editable = FALSE)


# Define a file name depending on the date
date <- Sys.Date()
file_name <- paste0("Rolling_Correlation_", date , ".csv")

write.csv2(correlation_df[, c(1, 2)], file_name, 
                           row.names = FALSE)

file_location <- paste0(getwd(), "/", file_name)

## Make the file accessible for download
readLines(file_location) %>% 
    paste0(collapse="\n") %>% 
    openssl::base64_encode() -> encoded