Create a monthtly Absorption Ratio graph

Question

Based on this link I would like to know how can I create this graph but montly instead of anually. I found that if I play with roll window in fragility function I can adapt the x-axis but Im not sure that this the correct solution since some data are getting lost. Any advice?

Required packages

library(quantmod)  # to download historical price time-series
library(plotly)    # for interactive visualization
library(xts)       # for time-series manipulation
library(reshape2)  # for data mainpulation

Get sector price time-series

sector_id <- c("XLY", "XLP", "XLE", "XLF", "XLV", "XLI", "XLB", "XLK", "XLU")
sector_names <- c("Consumer Disretionary", "Consumer Staples", "Energy", 
                  "Financials", "Health Care", "Industrials", "Materials", 
                  "Technology",
                  "Utilities")
sector_dat <- lapply(sector_id, "getSymbols", from = "1970-01-01",
                       to = "2018-04-28", src = "yahoo", auto.assign = FALSE)
sector_mat <- do.call("cbind", sector_dat)
sector_price <- sector_mat[, seq(from = 6, to = ncol(sector_mat), by = 6)]
sector_ret <- sector_price <- sector_price / lag.xts(sector_price, k = 1) - 1
sector_ret <- sector_ret[2:NROW(sector_ret), ]
colnames(sector_ret) <- sector_names

Alright, let’s set up a function to calculate the AR and the standardized change in AR,

fragility <- function(ret_mat, roll_window = 500, n_eigen = 2, 
                      method = c("delta", "raw"), 
                      delta_window = c(15, 250), half_life = TRUE)
{
  # FRAGILITY calculates the absorption ratio of a system of assets 
  #
  # ARGUMENTS:
  #   ret_mat = xts of asset returns, N x T
  #   roll_window = rolling window to calculate covariance matirx, default is
  #       504 days
  #   n_eigen = number of critical eigenvalues for AR calculation
  #   method = 'delta' for standardized change or 'raw' for the raw AR
  #   delta = window for standardized change calculation
  #   half_life = set to TRUE for exponential weighting in covariance estimation
  #
  # OUTPUT:
  #   xts of the AR
  
  if(n_eigen >= NCOL(ret_mat)) { 
    stop("n_eigen needs to be less than the number of asset columns")
  }
  
  date_array <- index(ret_mat)
  
  n <- NROW(ret_mat)
  raw_ar <- rep(NA, n - roll_window - 1)
  
  halfLife <- function(x) exp( -(x - 1:x) * log(2) / (x / 2))
  
  for (i in roll_window:n)
  {
    roll_ret <- ret_mat[(i - (roll_window - 1)):i, ]
    if (half_life == TRUE) roll_ret <- roll_ret * halfLife(roll_window)
    xcor <- cor(roll_ret)
    s <- svd(xcor)
    eigen_vec <- s$d
    raw_ar[i - (roll_window - 1)] <- cumsum(eigen_vec[1:n_eigen]) / 
      sum(eigen_vec)
  }
  
  raw_ar <- xts(raw_ar, date_array[roll_window:n])
  
  if (method[1] == "raw") {  
    return(raw_ar)
  } else {
    delta_ar <- array(dim = NROW(raw_ar) - delta_window[2] - 1)
    j <- 1
    for (i in delta_window[2]:NROW(raw_ar)) {
      raw_ar_long <- raw_ar[(i - (delta_window[2] - 1)):i, 1]
      raw_ar_short <- raw_ar[(i - (delta_window[1] - 1)):i, 1]
      delta_ar[j] <- (mean(raw_ar_short) - mean(raw_ar_long)) / sd(raw_ar_long)
      j <- j + 1
    }
    delta_ar <- xts(delta_ar, index(raw_ar)[delta_window[2]:NROW(raw_ar)])
    return(delta_ar)
  }
}

Let’s take our function for a spin.

delta_ar <- fragility(sector_ret) %>% round(2)
dat <- data.frame(delta_ar)
dat$t <- index(delta_ar)
g <- ggplot(dat, aes(x = t, y = delta_ar)) + 
  geom_line() + ylab("") + xlab("") + 
  geom_hline(yintercept = 2, col = "red") + 
  geom_hline(yintercept = -2, col = "green") + 
  ggtitle("Standardized Change of Absorption Ratio of US Equity") 
ggplotly(g)