Time Series on R Views

SEM Time Series Modeling

Fri, 22 Jan 2021 00:00:00 +0000

Andrea Luciani is a Technical Advisor for the Directorate General for Economics, Statistics and Research at the Bank of Italy, and co-author of the bimets package.

Structural Equation Models (SEM), which are common in many economic modeling efforts, require fitting and simulating whole system of equations where each equation may depend on the results of other equations. Moreover, they often require combining time series and regression equations in ways that are well beyond what the ts() and lm() functions were designed to do. For example, one might want to account for an error auto-correlation of some degree in the regression, or force linear restrictions modeling coefficients.

In this post, we will show how to do structural equation modeling in R by working through the Klein Model of the United States economy, one of the oldest and most elementary models of its kind.

These equations define the model:

$CN_t = \alpha_1 + \alpha_2 * P_t + \alpha_3 * P_{t-1} + \alpha_4 * ( WP_t + WG_t )$

$I_t = \beta_1 + \beta_2 * P_t + \beta_3 * P_{t-1} - \beta_4 * K_{t-1}$

$WP_t = \gamma_1 + \gamma_2 * ( Y_t + T_t - WG_t ) + \gamma_3 * ( Y_{t-1} + T_{t-1} - WG_{t-1} ) + \gamma_4 * Time$

$P_t = Y_t - ( WP_t + WG_t )$

$K_t = K_{t-1} + I_t$

$Y_t = CN_t + I_t + G_t - T_t$

Given:

$CN$ as private consumption expenditure;
$I$ as investment;
$WP$ as wage bill of the private sector (demand for labor);
$P$ as profits;
$K$ as stock of capital goods;
$Y$ as gross national product;
$WG$ as wage bill of the government sector;
$Time$ as an index of the passage of time, e.g. 1931 = zero;
$G$ as government expenditure plus net exports;
$T$ as business taxes.

$\alpha_i, \beta_j, \gamma_k$ are coefficient to be estimated.

This system has only 6 equations, three of which must be fitted in order to assess the coefficients. It may not seem so difficult to solve this system, but the real complexity emerges if you look at the incidence graph in the following figure, wherein endogenous variables are plotted in blue and exogenous variables are plotted in pink.

Each edge states a simultaneous dependence from a variable to another, e.g. the WP equation depends on the current value of the TIME time series; complexity arises because in this model there are several circular dependencies, one of which is plotted in dark blue.

A circular dependency in the incidence graph of a model implies that the model is a “simultaneous” equations model and that it must be estimated by using ad-hoc procedures; moreover it can be simulated, i.e. performing a forecast, only by using an iterative algorithm.

If we search for “simultaneous equations” inside the Econometrics Task View web page we can find two results: the systemfit and the bimets packages.

The systemfit package is a powerful tool for econometric estimation of simultaneous systems of linear and nonlinear equations, but it only provides fitting procedures, thus it cannot be used in our example in order to work out a forecast.

On the other hand, the bimets package implements, among others, simulation and forecasting procedures; as stated into the vignette it allows users to write down the model in a natural way, to test several strategies and to focus on the econometric analysis, without overly dealing with coding.

Time series projection, linear restrictions and error auto-correlation can be triggered directly in the model definition, so let us try to define a similar but more complex Klein model by using a bimets compliant syntax:

#load library
library(bimets)

#define the Klein model
kleinModelDef <- "
MODEL

COMMENT> Modified Klein Model 1 of the U.S. Economy with PDL, 
COMMENT> autocorrelation on errors, restrictions and conditional equation evaluations

COMMENT> Consumption with autocorrelation on errors
BEHAVIORAL> cn
TSRANGE 1923 1 1940 1
EQ> cn =  a1 + a2*p + a3*TSLAG(p,1) + a4*(wp+wg) 
COEFF> a1 a2 a3 a4
ERROR> AUTO(2)

COMMENT> Investment with restrictions
BEHAVIORAL> i
TSRANGE 1923 1 1940 1
EQ> i = b1 + b2*p + b3*TSLAG(p,1) + b4*TSLAG(k,1)
COEFF> b1 b2 b3 b4
RESTRICT> b2 + b3 = 1

COMMENT> Demand for Labor with PDL
BEHAVIORAL> wp 
TSRANGE 1923 1 1940 1
EQ> wp = c1 + c2*(y+t-wg) + c3*TSLAG(y+t-wg,1) + c4*time
COEFF> c1 c2 c3 c4
PDL> c3 1 2

COMMENT> Gross National Product
IDENTITY> y
EQ> y = cn + i + g - t

COMMENT> Profits
IDENTITY> p
EQ> p = y - (wp+wg)

COMMENT> Capital Stock with IF switches
IDENTITY> k
EQ> k = TSLAG(k,1) + i
IF> i > 0
IDENTITY> k
EQ> k = TSLAG(k,1) 
IF> i <= 0

END
"

#load the model
kleinModel <- LOAD_MODEL(modelText = kleinModelDef)

## Analyzing behaviorals...
## Analyzing identities...
## Optimizing...
## Loaded model "kleinModelDef":
##     3 behaviorals
##     3 identities
##    12 coefficients
## ...LOAD MODEL OK

The code is quite intuitive and uses explicit keywords in order to define equations, coefficients, parameters, etc. Users can easily:

change the TSRANGE in order to fit the model in a custom time range per equation;
modify an equation EQ without changing any user procedure or code;
add or remove one or more linear restriction on the coefficients by using the keyword RESTRICT, e.g.
RESTRICT> -1.23*b2 + 8.9*b3 = 0.34
RESRTICT> b4 – 1.2*b1 = 5
add or remove an error auto-correlation structure with an arbitrary order by using the keyword:
ERROR>

Equations can contain advanced expressions, e.g.:

EQ> TSDELTA(i) = b1 + b2*EXP(p/1000) + b3*TSDELTALOG(TSLAG(p,1)) + b4*MOVAVG(TSLAG(k,1),5)

Model estimation

Now, we define time series to be used in our example, and then we perform an estimation of the whole kleinModel by using the command ESTIMATE():

#define data
kleinModelData <- list(  
  cn  =TIMESERIES(39.8,41.9,45,49.2,50.6,52.6,55.1,56.2,57.3,57.8,
                  55,50.9,45.6,46.5,48.7,51.3,57.7,58.7,57.5,61.6,65,69.7,  
                  START=c(1920,1),FREQ=1),
  g   =TIMESERIES(4.6,6.6,6.1,5.7,6.6,6.5,6.6,7.6,7.9,8.1,9.4,10.7,
                  10.2,9.3,10,10.5,10.3,11,13,14.4,15.4,22.3,   
                  START=c(1920,1),FREQ=1),
  i   =TIMESERIES(2.7,-.2,1.9,5.2,3,5.1,5.6,4.2,3,5.1,1,-3.4,-6.2,
                  -5.1,-3,-1.3,2.1,2,-1.9,1.3,3.3,4.9,  
                  START=c(1920,1),FREQ=1),
  k   =TIMESERIES(182.8,182.6,184.5,189.7,192.7,197.8,203.4,207.6,
                  210.6,215.7,216.7,213.3,207.1,202,199,197.7,199.8,
                  201.8,199.9,201.2,204.5,209.4,    
                  START=c(1920,1),FREQ=1),
  p   =TIMESERIES(12.7,12.4,16.9,18.4,19.4,20.1,19.6,19.8,21.1,21.7,
                  15.6,11.4,7,11.2,12.3,14,17.6,17.3,15.3,19,21.1,23.5, 
                  START=c(1920,1),FREQ=1),
  wp  =TIMESERIES(28.8,25.5,29.3,34.1,33.9,35.4,37.4,37.9,39.2,41.3,
                  37.9,34.5,29,28.5,30.6,33.2,36.8,41,38.2,41.6,45,53.3,    
                  START=c(1920,1),FREQ=1),
  y   =TIMESERIES(43.7,40.6,49.1,55.4,56.4,58.7,60.3,61.3,64,67,57.7,
                  50.7,41.3,45.3,48.9,53.3,61.8,65,61.2,68.4,74.1,85.3, 
                  START=c(1920,1),FREQ=1),
  t   =TIMESERIES(3.4,7.7,3.9,4.7,3.8,5.5,7,6.7,4.2,4,7.7,7.5,8.3,5.4,
                  6.8,7.2,8.3,6.7,7.4,8.9,9.6,11.6, 
                  START=c(1920,1),FREQ=1),
  time=TIMESERIES(NA,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1,0,
                  1,2,3,4,5,6,7,8,9,10, 
                  START=c(1920,1),FREQ=1),
  wg  =TIMESERIES(2.2,2.7,2.9,2.9,3.1,3.2,3.3,3.6,3.7,4,4.2,4.8,
                  5.3,5.6,6,6.1,7.4,6.7,7.7,7.8,8,8.5,  
                  START=c(1920,1),FREQ=1)
);

#load time series into the model object
kleinModel <- LOAD_MODEL_DATA(kleinModel,kleinModelData)

## Load model data "kleinModelData" into model "kleinModelDef"...
## ...LOAD MODEL DATA OK

#estimate the model
kleinModel <- ESTIMATE(kleinModel, quietly=TRUE)

In order to reduce this blog post length we only show the output for a single estimation; anyhow, for each estimated equation the output is similar to the following:

kleinModel <- ESTIMATE(kleinModel, eqList='cn')

## 
## Estimate the Model kleinModelDef:
## the number of behavioral equations to be estimated is 1.
## The total number of coefficients is 4.
## 
## _________________________________________
## 
## BEHAVIORAL EQUATION: cn
## Estimation Technique: OLS
## Autoregression of Order  2  (Cochrane-Orcutt procedure)
## 
## Convergence was reached in  6  /  20  iterations.
## 
## 
## cn                  =   14.83    
##                         T-stat. 7.608    ***
## 
##                     +   0.2589   p
##                         T-stat. 2.96     *
## 
##                     +   0.01424  TSLAG(p,1)
##                         T-stat. 0.1735   
## 
##                     +   0.839    (wp+wg)
##                         T-stat. 14.68    ***
## 
## ERROR STRUCTURE:  AUTO(2) 
## 
## AUTOREGRESSIVE PARAMETERS:
## Rho          Std. Error   T-stat.      
##  0.2542       0.2589       0.9817       
## -0.05251      0.2594      -0.2024       
## 
## 
## STATs:
## R-Squared                      : 0.9827   
## Adjusted R-Squared             : 0.9755   
## Durbin-Watson Statistic        : 2.256    
## Sum of squares of residuals    : 8.072    
## Standard Error of Regression   : 0.8201   
## Log of the Likelihood Function : -18.32   
## F-statistic                    : 136.2    
## F-probability                  : 3.874e-10
## Akaike's IC                    : 50.65    
## Schwarz's IC                   : 56.88    
## Mean of Dependent Variable     : 54.29    
## Number of Observations         : 18
## Number of Degrees of Freedom   : 12
## Current Sample (year-period)   : 1923-1 / 1940-1
## 
## 
## Signif. codes:   *** 0.001  ** 0.01  * 0.05  
## 
## 
## ...ESTIMATE OK

The ESTIMATE() function can fit also non-simultaneous system and a single equation. Several predefined time series transformations are available in bimets:

– Time series extension TSEXTEND()
– Time series merging TSMERGE()
– Time series projection TSPROJECT()
– Lag TSLAG()
– Lag differences: standard, percentage and logarithmic, i.e. TSDELTA(), TSDELTAP(), TSDELTALOG()
– Cumulative product CUMPROD()
– Cumulative sum CUMSUM()
– Moving average MOVAVG()
– Moving sum MOVSUM()
– Parametric (Dis)Aggregation YEARLY(), QUARTERLY(), MONTHLY(), DAILY()
– Time series data presentation TABIT()

Forecasting

The predict() function of the lm() or dyn$lm linear model framework produces predicted values, obtained by evaluating the regression function with new data: it is a popular function among the R users.

Unfortunately, it does not help in our example: as we said before, in order to forecast a simultaneous model that presents circular dependencies in the incidence graph, we cannot merely assess the right-hand side of the equations, as the predict.lm function does; in our case we need an iterative algorithm.

The predict.lm equivalent function that allows to forecast our simultaneous model is the SIMULATE() function. On the other hand the SIMULATE() function can also solve non-simultaneous models and gives the same results as the predict.lm function.

In addition, as in the Capital Stock k equation in our example, the SIMULATE() function can conditionally evaluate an identity during a simulation, depending on the value of a logical expression (e.g. for each simulation period the k equation changes depending on the i current value). Thus, it is possible to have a model alternating between two or more equation specifications for each simulation period, depending upon results from other equations.

Structural stability, multiplier analysis and endogenous targeting are additional capabilities coded in bimets but not described in this post.

In order to forecast the model up to 1944, we need to extend exogenous time series by using the TSEXTEND() function. In this example, we perform simple extensions:

#we need to extend exogenous variables up to 1944
kleinModel$modelData <- within(kleinModel$modelData,{
    wg    = TSEXTEND(wg,  UPTO=c(1944,1),EXTMODE='CONSTANT')
    t     = TSEXTEND(t,   UPTO=c(1944,1),EXTMODE='LINEAR')
    g     = TSEXTEND(g,   UPTO=c(1944,1),EXTMODE='CONSTANT')
    k     = TSEXTEND(k,   UPTO=c(1944,1),EXTMODE='LINEAR')
    time  = TSEXTEND(time,UPTO=c(1944,1),EXTMODE='LINEAR')
  })

A call to the SIMULATE() function will solve our simultaneous system of equations:

#forecast model
kleinModel <- SIMULATE(kleinModel
                      ,simType='FORECAST'
                      ,TSRANGE=c(1941,1,1944,1)
                      ,simConvergence=0.00001
                      ,simIterLimit=100
                      ,quietly=TRUE
  )

The historical GNP (original referred as “Net national income, measured in billions of 1934 dollars” , pg. 141 in “Economic Fluctuations in the United States 1921-1941” by L. R. Klein, Wiley and Sons Inc., New York, 1950) is shown in figure, along with the simulation and the forecast.

#get forecasted GNP
TABIT(kleinModel$simulation$y)

## 
##       DATE, PER, kleinModel$simulation$y
## 
##       1941, 1  ,  125.3      
##       1942, 1  ,  172.5      
##       1943, 1  ,  185.6      
##       1944, 1  ,  141.1

Disclaimer: The views and opinions expressed in this page are those of the author and do not necessarily reflect the official policy or position of the Bank of Italy. Examples of analysis performed within these pages are only examples. They should not be utilized in real-world analytic products as they are based only on very limited and dated open source information. Assumptions made within the analysis are not reflective of the position of the Bank of Italy.

Learning things we already know about stocks

Tue, 22 Aug 2017 00:00:00 +0000

This example groups stocks together in a network that highlights associations within and between the groups using only historical price data. The result is far from ground-breaking: you can already guess the output. For the most part, the stocks get grouped together into pretty obvious business sectors.

Despite the obvious result, the process of teasing out latent groupings from historic price data is interesting. That’s the focus of this example. A central idea of the approach taken here comes from the great paper of Ledoit and Wolf, “Honey, I Shrunk the Sample Covariance Matrix” (http://www.ledoit.net/honey.pdf). This example employs an alternative approach based on a matrix eigenvalue decomposition, but it’s the same general idea.

This note follows an informal, how-to format. Rather than focus on mathematical analysis, which is well-detailed in the references, I try to spell out the how’s and why’s: how to do things step by step (using R) and a somewhat non-rigorous rationale for each step that’s hopefully at least convincing and intuitive.

For emphasis, allow me to restate the first sentence as an objective:

Group stocks together in a network that highlights associations within and between the groups using only historical price data.

That’s what the rest of this example will do, hopefully illuminating some key ideas about regularization along the way.

Software used in the example

The example uses R of course, and the following R packages, all available on CRAN (some of the packages themselves have dependencies):

quantmod (at least version 0.4-10)
igraph (at least version 1.1.2)
threejs (at least version 0.3.1)

Getting data

NOTE: You can skip ahead to the Sample correlation section by simply downloading a sample copy of processed log(return) data as follows:

library(quantmod)
load(url("http://illposed.net/logreturns.rdata"))

Otherwise, follow the next two sections to download the raw stock daily price data and process those data into log(returns).

Download daily closing price data from Google Finance

The quantmod package (Ulrich and Ryan, http://www.quantmod.com/) makes it ridiculously easy to download (and visualize) financial time series data. The following code uses quantmod to download daily stock price data for about 100 companies with the largest market capitalizations listed on the Standard & Poor’s 500 index at the time of this writing. The code downloads daily closing prices from 2012 until the present. Modify the code to experiment with different time periods or stocks as desired!

Because stock symbol names may change and companies my come and go, it’s possible that some of the data for some time periods are not available. The tryCatch() block in the code checks for a download error and flags problems by returning NA, later removed from the result. The upshot is that the output number of columns of stock price time series may be smaller than the input list of stock symbols.

The output of the following code is an xts time series matrix of stock prices called prices whose rows correspond to days and columns to stock symbols.

library(quantmod)
from="2012-05-17"
sym = c("AAPL", "ABBV", "ABT", "ACN", "AGN", "AIG", "ALL", "AMGN", "AMZN", "AXP",
        "BA", "BAC", "BIIB", "BK", "BLK", "BMY", "BRK.B", "C", "CAT", "CELG", "CL",
        "CMCSA", "COF", "COP", "COST", "CSCO", "CVS", "CVX", "DD", "DHR", "DIS", "DOW",
        "DUK", "EMR", "EXC", "F", "FB", "FDX", "FOX", "FOXA", "GD", "GE", "GILD", "GM",
        "GOOG", "GOOGL", "GS", "HAL", "HD", "HON", "IBM", "INTC", "JNJ", "JPM", "KHC",
        "KMI", "KO", "LLY", "LMT", "LOW", "MA", "MCD", "MDLZ", "MDT", "MET", "MMM",
        "MO", "MON", "MRK", "MS", "MSFT", "NEE", "NKE", "ORCL", "OXY", "PCLN", "PEP",
        "PFE", "PG", "PM", "PYPL", "QCOM", "RTN", "SBUX", "SLB", "SO", "SPG", "T",
        "TGT", "TWX", "TXN", "UNH", "UNP", "UPS", "USB", "UTX", "V", "VZ", "WBA",
        "WFC", "WMT", "XOM")

prices = Map(function(n)
             {
               print(n)
               tryCatch(getSymbols(n, src="google", env=NULL, from=from)[, 4], error = function(e) NA)
             }, sym)
N = length(prices)
# identify symbols returning valid data
i = ! unlist(Map(function(i) is.na(prices[i]), seq(N)))
# combine returned prices list into a matrix, one column for each symbol with valid data
prices = Reduce(cbind, prices[i])
colnames(prices) = sym[i]

Clean up and transform data

Not every stock symbol may have prices available for every day. Trading can be suspended for some reason, companies get acquired or go private, new companies form, etc.

Let’s fill in missing values going forward in time using the last reported price (piecewise constant interpolation)–a reasonable approach for stock price time series. After that, if there are still missing values, just remove those symbols that contain them, possibly further reducing the universe of stock symbols we’re working with.

for(j in 1:ncol(prices)) prices[, j] = na.locf(prices[, j])       # fill in
prices = prices[, apply(prices, 2, function(x) ! any(is.na(x)))]  # omit stocks with missing data

Now that we have a universe of stocks with valid price data, convert those prices to log(returns) for the remaining analysis (by returns I mean simply the ratio of prices relative to the first price).

Why log(returns) instead of prices?

The log(returns) are closer to normally distributed than prices especially in the long run. Pat Burns wrote a note about this (with a Tom Waits soundrack): http://www.portfolioprobe.com/2012/01/23/the-distribution-of-financial-returns-made-simple/.

But why care about getting data closer to normally distributed?

That turns out to be important to us because later we’ll use a technique called partial correlation. That technique generally works better for normally distributed data than otherwise, see for example a nice technical discussion about this by Baba, Shibata, and Sibuya here: https://doi.org/10.1111%2Fj.1467-842X.2004.00360.x

The following simple code converts our prices matrix into a matrix of log(returns):

log_returns = apply(prices, 2, function(x) diff(log(x)))

Sample correlation matrix

It’s easy to convert the downloaded log(returns) data into a Pearson’s sample correlation matrix X:

X = cor(log_returns)

The (i, j)th entry of the sample correlation matrix X above is a measurement of the degree of linear dependence between the log(return) series for the stocks in columns i and j.

There exist at least two issues that can lead to serious problems with the interpretation of the sample correlation values:

As Ledoit and Wolf point out, it’s well-known that empirical correlation estimates may contain lots of error.

Correlation estimates between two stock log(return) series can be misleading for many reasons, including spurious correlation or existence of confounding variables related to both series (http://www.tylervigen.com/spurious-correlations).

A Nobel-prize winning approach to dealing with the second problem considers cointegration between series instead of correlation, see for example notes by Eric Zivot (https://faculty.washington.edu/ezivot/econ584/notes/cointegrationslides.pdf), or Bernhard Pfaff’s lovely book “Analysis of Integrated and Cointegrated Time Series with R” (http://www.springer.com/us/book/9780387759661), or Wikipedia (https://en.wikipedia.org/wiki/Cointegration). (I also have some weird technical notes on the numerics of cointegration at http://illposed.net/cointegration.html.)

Cointegration is a wonderful but fairly technical topic. Instead, let’s try a simpler approach.

We can try to address issue 2 above by controlling for confounding variables, at least partially. One approach considers partial correlation instead of correlation (see for example the nice description in Wikipedia https://en.wikipedia.org/wiki/Partial_correlation). That approach works best in practice with approximately normal data–one reason for the switch to log(returns) instead of prices. We will treat the entries of the precision matrix as measures of association in a network of stocks below.

It’s worth stating that our simple approach basically treats the log(returns) series as a bunch of vectors and not so much bona fide time series, and can’t handle as many pathologies that might occur as well as cointegration can. But as we will see, this simple technique is still pretty effective at finding structure in our data. (And indeed related methods as discussed by Ledoit and Wolf and elsewhere are widely used in portfolio and risk analyses in practice.)

The partial correlation coefficients between all stock log(returns) series are the entries of the inverse of the sample correlation matrix (https://www.statlect.com/glossary/precision-matrix).

Market trading of our universe of companies, with myriad known and unknown associations between them and the larger economy, produced the stock prices we downloaded. Our objective is a kind of inverse problem: given a bunch of historical stock prices, produce a network of associations.

You may recall from some long ago class that, numerically speaking, inverting matrices is generally a bad idea. Even worse, issue 1 above says that our estimated correlation coefficients contain error (noise). Even a tiny amount noise can be hugely amplified if we invert the matrix. That’s because, as we will soon see, the sample correlation matrix contains tiny eigenvalues and matrix inversion effectively divides the noise by those tiny values. Simply stated, dividing by a tiny number returns a big number–that is, matrix inversion tends to blow the noise up. This is a fundamental issue (in a sense, the fundamental issue) common to many inverse problems.

Ledoit and Wolf’s sensible answer to reducing the influence of noise is regularization. Regularization replaces models with different, but related, models designed to reduce the influence of noise on their output. LW use a form of regularization related to ridge regression (a. k. a. Tikhonov regularization) with a peculiar regularization operator based on a highly structured estimate of the covariance. We will use a simpler kind of regularization based on an eigenvalue decomposition of the sample correlation matrix X.

Regularization

Here is an eigenvalue decomposition of the sample correlation matrix:

L = eigen(X, symmetric=TRUE)

Note that R’s eigen() function takes care to return the (real-valued) eigenvalues of a symmetric matrix in decreasing order for us. (Technically, the correlation matrix is symmetric positive semi-definite, and will have only nonnegative real eigenvalues.)

Each eigenvector represents an orthogonal projection of the sample correlation matrix into a line (a 1-d shadow of the data); The first two eigenvectors define a projection of the sample correlation matrix into a plane (2-d), and so on. The eigenvalues estimate the proportion of information (or variability if you prefer) from the original sample correlation matrix contained in each eigenvector. Because the eigenvectors are orthogonal, these measurements of projected information are additive.

Here is a plot of all the sample correlation matrix eigenvalues (along with a vertical line that will be explained in a moment):

plot(L$values, ylab="eigenvalues")
abline(v=10)

The eigenvalues fall off rather quickly in our example! That means that a lot of the information in the sample correlation matrix is contained in the first few eigenvectors.

Let’s assume, perhaps unreasonably, that the errors in our estimate of the correlation matrix are equally likely to occur in any direction (that the errors are white noise, basically). As we can see above, most of the information is concentrated in the subspace corresponding to the first few eigenvectors. But white noise will have information content in all the dimensions more or less equally.

One regularization technique replaces the sample correlation matrix with an approximation defined by only its first few eigenvectors. Because they represent a large amount of the information content, the approximation can be pretty good. More importantly, because we assumed noise to be more or less equally represented across the eigenvector directions and we’re cutting most of those off, this approximation tends to damp the noise more than the underlying information. Most importantly, we’re cutting off the subspace associated with tiny eigenvalues, avoiding the problem of division by tiny values and significantly reducing amplified noise in the inverse of the sample correlation matrix (the precision matrix).

The upshot is, we regularize the sample correlation matrix by approximating it by a low-rank matrix that substantially reduces the influence of noise on the precision matrix. See Per Christian Hansen’s classic paperback “Rank-Deficient and Discrete Ill-Posed Problems” (http://epubs.siam.org/doi/book/10.1137/1.9780898719697) for insight into related topics.

But how to choose a cut-off rank?

There is a substantial mathematical literature for just this topic (regularization parameter choice selection), complete with deep theory as well as lots of heuristics. Let’s keep things simple for this example and form our approximation by cutting off eigenvectors beyond where the eigenvalue plot starts to flatten out – close to the vertical line in the above plot.

Alternatively consider the lovely short 2004 paper by Chris Ding and Xiaofeng He (http://dl.acm.org/citation.cfm?id=1015408) that illuminates connections (that I happen to find fascinating) between k-means clustering and projections like truncated eigenvalue expansions. Although we aren’t interested in k-means clustering per se, our objective is connected to clustering. Ding and He show that we can find at least k (k-means) clusters using the first k - 1 eigenvectors above. This gives us another heuristic way to choose a projection dimension, at least if we have an idea about the number of clusters to look for.

A precision matrix, finally

Finally, we form the precision matrix P from the regularized sample correlation matrix. The inversion is less numerically-problematic now because of regularization. Feel free to experiment with the projected rank N below!

N = 10  # (use 1st 10 eigenvectors, set N larger to reduce regularization)
P = L$vectors[, 1:N] %*% ((1 / L$values[1:N]) * t(L$vectors[, 1:N]))
P = P / tcrossprod(sqrt(diag(P)))

Other approaches

I’m not qualified to write about them, but you should be aware that Bayesian approaches to solving problems like this are also effectively (and effective!) regularization methods. I hope to someday better understand the connections between classical inverse problem solution methods that I know a little bit about, and Bayesian methods that I know substantially less about.

Put a package on it

There is a carefully written R package to construct regularized correlation and precision matrices: the corpcor package (https://cran.r-project.org/package=corpcor, and also see http://strimmerlab.org/software/corpcor/) by Juliane Schafer, Rainer Opgen-Rhein, Verena Zuber, Miika Ahdesmaki, A. Pedro Duarte Silva, and Korbinian Strimmer. Their package includes the original Ledoit Wolf-like regularization method, as well as refinements to it and many other methods. The corpcor package, like Ledoit Wolf, includes ways to use sophisticated regularization operators and can apply more broadly than the simple approach taken in this note.

You can use the corpcor package to form a Ledoit-Wolf-like regularized precision matrix P, and you should try it! The result is pretty similar to what we get from our simple truncated eigenvalue decomposition regularization in this example.

Networks and clustering

The (i, j)th entry of the precision matrix P is a measure of association between the log(return) time series for the stocks in columns i and j, with larger values corresponding to more association.

An interesting way to group related stocks together is to think of the precision matrix as an adjacency matrix defining a weighted, undirected network of stock associations. Thresholding entries of the precision matrix to include, say, only the top ten per cent results in a network of only the most strongly associated stocks.

Thinking in terms of networks opens up a huge and useful toolbox: graph theory. We gain access to all kinds of nifty ways to analyze and visualize data, including methods for clustering and community detection.

R’s comprehensive igraph package by Gábor Csárdi (https://cran.r-project.org/package=igraph) includes many network cluster detection algorithms. The example below uses Blondel and co-authors’ fast community detection algorithm implemented by igraph’s cluster_louvain() function to segment the thresholded precision matrix of stocks into groups. The code produces an igraph graph object g, with vertices colored by group membership.

suppressMessages(library(igraph))

threshold = 0.90
Q = P * (P > quantile(P, probs=threshold))                           # thresholded precision matrix
g = graph.adjacency(Q, mode="undirected", weighted=TRUE, diag=FALSE) # ...expressed as a graph

# The rest of the code lumps any singletons lacking edges into a single 'unassociated' group shown in gray
# (also assigning distinct colors to the other groups).
x = groups(cluster_louvain(g))
i = unlist(lapply(x, length))
d = order(i, decreasing=TRUE)
x = x[d]
i = i[d]
j = i > 1
s = sum(j)
names(x)[j] = seq(1, s)
names(x)[! j] = s + 1
grp = as.integer(rep(names(x), i))
clrs = c(rainbow(s), "gray")[grp[order(unlist(x))]]
g = set_vertex_attr(g, "color", value=clrs)

Use the latest threejs package to make a nice interactive visualization of the network (you can use your mouse/trackpad to rotate, zoom and pan the visualization).

library(threejs)
graphjs(g, vertex.size=0.2, vertex.shape=colnames(X), edge.alpha=0.5)

The stock groups identified by this method are uncanny, but hardly all that surprising really. Look closely and you will see clusters made up of bank-like companies (AIG, BAC, BK, C, COF, GS, JPM, MET, MS, USB, WFC), pharmaceutical companies (ABT, AMGN, BIIB, BMY, CELG, GILD, JNJ, LLY, MRK, PFE), computer/technology-driven companies (AAPL, ACN, CSCO, IBM, INTC, MSFT, ORCL, QCOM, T, TXN, VZ, and so on. With the threshold value of 0.9 above, a few stocks aren’t connected to any others – they appear in gray.

The groups more or less correspond to what we already know!

The FB, GOOG, AMZN, PCLN (Facebook, Alphabet/Google, Amazon, Priceline) group is interesting–it includes credit card companies V (Visa), MA (Mastercard). Perhaps the returns of FB, GOOG and AMZN are more closely connected to consumer spending than technology!

This way of looking at things also nicely highlights connections between groups. For instance, the pharma group is connected to consumer products group through JNJ and PG (Johnson and Johnson and Proctor and Gamble). See the appendix below for a visualization that explores different precision matrix threshold values, including lower values with far greater network connectivity.

Review

We downloaded daily closing stock prices for 100 stocks from the S&P 500, and, using basic tools of statistics and analysis like correlation and regularization, we grouped the stocks together in a network that highlights associations within and between the groups. The structure teased out of the stock price data is reasonably intuitive.

Appendix: threejs tricks

The following self-contained example shows how the network changes with threshold value. It performs the same steps as we did above, but uses some tricks in threejs and an experimental extension to the crosstalk package and a few additional R packages to present an interactive animation. Enjoy!

suppressMessages({
library(quantmod)
library(igraph)
library(threejs)
library(crosstalk)
library(htmltools)
# using an experimental extension to crosstalk:
library(crosstool) # devtools::install_github('bwlewis/crosstool')
})

# Download the processed log(returns) data:
suppressMessages(load(url("http://illposed.net/logreturns.rdata")))

X = cor(log_returns)
L = eigen(X, symmetric=TRUE)
N = 10  # (use 1st 10 eigenvectors, set N larger to reduce regularization)
P = L$vectors[, 1:N] %*% ((1 / L$values[1:N]) * t(L$vectors[, 1:N]))
P = P / tcrossprod(sqrt(diag(P)))
colnames(P) = colnames(X)

# A function that creates a network for a given threshold and precision matrix
f = function(threshold, P)
{
  Q = P * (P > quantile(P, probs=threshold))                           # thresholded precision matrix
  g = graph.adjacency(Q, mode="undirected", weighted=TRUE, diag=FALSE) # ...expressed as a graph

  x = groups(cluster_louvain(g))
  i = unlist(lapply(x, length))
  d = order(i, decreasing=TRUE)
  x = x[d]
  i = i[d]
  j = i > 1
  s = sum(j)
  names(x)[j] = seq(1, s)
  names(x)[! j] = s + 1
  grp = as.integer(rep(names(x), i))
  clrs = c(rainbow(s), "gray")[grp[order(unlist(x))]]
  g = set_vertex_attr(g, "color", value=clrs)
  set_vertex_attr(g, "shape", value=colnames(P))
}

threshold = c(0.97, 0.95, 0.90, 0.85, 0.8)
g = Map(f, threshold, MoreArgs=list(P=P)) # list of graphs, one for each threshold

# Compute force-directed network layouts for each threshold value
# A bit expensive to compute, so run in parallel!
library(parallel)
l = mcMap(function(x) layout_with_fr(x, dim=3, niter=150), g, mc.cores=detectCores())

sdf = SharedData$new(data.frame(key=paste(seq(0, length(threshold) - 1))), key=~key)
slider = crosstool(sdf, "transmitter",
                sprintf("<input type='range' min='0' max='%d' value='0'/>",
                length(threshold) - 1), width="100%", height=20, channel="filter")
vis = graphjs(g, l, vertex.size=0.2, main=as.list(threshold), defer=TRUE, edge.alpha=0.5, deferfps=30,
        crosstalk=sdf, width="100%", height=900)

browsable(div(list(HTML("<center>"), tags$h3("Precision matrix quantile threshold (adjust slider to change)"), slider, vis)))

Precision matrix quantile threshold (adjust slider to change)

Editors Note: This post was revised on 8/28/17 to include a correction by the author that rescales the precision matrix.

Mapping Quandl Data with Shiny

Wed, 14 Jun 2017 00:00:00 +0000

Today, we are going to wrap our previously built Quandl/world map Notebook into an interactive Shiny app that lets users choose both a country and a data set for display. As usual, we did a lot of the heavy lifting in the Notebook to make our work more reproducible and our app more performant. The final app is available here.

Devotees of this Reproducible Finance blog series will note similarities to this Shiny app, but today’s app will have different and richer functionality.

First, we are going to be pulling in data from Quandl, so we won’t be using ticker symbols, but rather will be using country codes plus data set codes. That would allow us to open this app to the vast number of data sets available via Quandl.

Second, the user will be able to use the sidebar to select different data sets, rather than being restricted to a country ETF. For example, the user might want to select GDP-per-capita, or the exchange rate, or any data set that we wish to make available. Our app today will include 6 economic indicators.

Third, we will display a chart using highcharter instead of dygraphs. There’s not a substantive reason to be doing this, beyond that it’s a good chance to start exploring highcharter, which is a popular tool in the financial world.

Lastly, we’ll port raw data to a data.table and include a few buttons for easy download, in case our end users want to reproduce our charts or import data for their own work. We are going to use the as_tibble function from the fantastically useful new tidyquant package to facilitate our data.table. We won’t have space to cover the data download section in this post, but all the code is available in the live app.

Without further ado, let’s get to it.

The first line of substance in this app loads in the leaflet map we constructed in our Notebook. We named the object leaf_world and saved it in a file called wdiMapData.RDat. If you want to refresh your memory on how we did that, have a look back at the previous post. Apologies if that sounds tedious, but hopefully it emphasizes the workflow of doing the heavy map-building in the Notebook when possible. If you or your team ever want to use that map as the basis for another Shiny app, that Notebook will be convenient to reuse.

To load our map, we run the following:

# Load the .RDat file where the leaflet map is saved.
load('wdiMapData.RDat')

Now we can access whatever R objects were saved in that file and, in this case, that means one R object called leaf_world. That might not be a great name, but it’s the leaflet map of the world we built in the Notebook. When we are ready to build the map in our Shiny app, we’ll simply render that object.

Before we get to the map, though, let’s construct a sidebar where the user can choose which data set to display. We are going to be working with a macroeconomic data source from the World Bank called World Development Indicators WDI. The Quandl code for WDI is WWDI and thus we’ll append WWDI/ to each data set call - but note that this will not appear in the sidebar because we won’t actually pass any data to Quandl there. We have to wait for the user to click on a county, and thus will handle the data passing in a future code chunk. This sidebar has one purpose: for the user to select the code for the economic indicator.

We want to give the user a drop-down of choices, but we don’t want the choices to be the Quandl codes. We want the choices to be the familiar names of the data sets. In other words, the user will see as a choice ‘GDP Per Capita’, instead of the Quandl code _NY_GDP_PCAP_KN. For that reason, we’ll first create an object called dataChoices that holds our name-value pairs. The name is the familiar title of the time series - for example, ’GDP Per Capita` - and the value is the Quandl code.

dataChoices <- c("GDP Per Capita" = "_NY_GDP_PCAP_KN",
                  "GDP Per Capita Growth" = "_NY_GDP_PCAP_KD_ZG",
                  "Real Interest Rate" = "_FR_INR_RINR",
                  "Exchange Rate" = "_PX_REX_REER",
                  "CPI" = "_FP_CPI_TOTL_ZG",
                  "Labor Force Part. Rate" = "_SL_TLF_ACTI_ZS")

Next, in our selectInput statement, we will set choices equal to dataChoices, which will allow the user to see intuitive names but choose the Quandl codes.

selectInput("indicatorSelect", 
            "Choose an economic indicator",
            # Give the user a choice from the object we created above.
            choices = dataChoices,
            selected = "GDP Per Capita")

Our simple sidebar is finished, and the end result is that when a user makes a choice, we have an input reactive with the value of the data set code. Let’s put that code aside for a minute and turn our attention to the map.

Remember, we did the map-building work on this in our Notebook, then loaded the object in the setup code chunk. That leaves us with a simple call to renderLeaflet() to pass it leaf_world.

leafletOutput("map1")

output$map1 <- renderLeaflet({
  leaf_world
  })

Alright, that wasn’t too cumbersome, and perhaps the simplicity of that step makes the hard work in the previous Notebook a bit more tolerable.

And now the fun part, wherein we build the machinery to let a user click the map and grab data from Quandl. We will proceed in four steps:

capture the country code of the country that gets clicked
call the economic time series that the user selected in the sidebar
paste the country code and the time series together to create one data set code
pass that one data set code to Quandl and import the time series

On to step 1, capturing the clicked country.

clickedCountry <- eventReactive(input$map1_shape_click, {
  return(input$map1_shape_click$id)
})

It’s same process we used in this post, but there is one difference. Let’s review what happened here.

Recall that we set layerID = ~iso_a3 when we built the map in our Notebook. That’s because Quandl appends the iso_a3 country codes to the data set code. In other words, if we want GDP-per-capita for Brazil, we need the Brazil country code ‘BRA’ so we can later append it to the GDP-per-capita code ’_NY_GDP_PCAP_KN’.

In the code chunk above, we used an observeEvent function to capture the layerID of whatever shape a user clicks, and in the Notebook, we had set that ID to be the ~isa_a3 code. When a user clicks Brazil, our reactive captures the country code ‘BRA’.

Next, we need to append that country code to the data set code. Recall that the user chose this code in our sidebar. We just need to grab his selection via another reactive.

# Nothing fancy here, a reactive value from our sidebar input.
indicatorValue <- reactive({input$indicatorSelect})

Let’s pause and take inventory of what we have captured thus far: the country code from the click on the map is stored as clickedCountry(), and the data set code from the sidebar is stored as indicatorValue(). Now we want to paste those together and pass them to Quandl. We’ll do that via another reactive, but we are also going to pass that pasted chain to Quandl in the reactive. Thus, the chunk below has one reactive that does two things.

First, it pastes together our inputs to form one data set code. Second, it passes that code to Quandl and returns the desired time series.

Notice that when we paste the codes together, we start with WWDI/. That’s because all of our data comes from the WWDI data source on Quandl. We are not letting the user choose a different data source. We could have done so in the sidebar, but consider how that would have complicated our data set code reactive input in the sidebar.

Back to our data import chunk wherein we create our data set code by pasting inputs together and then pass them to Quandl:

countryData <- reactive({
  
  # WWDI is the World Bank data set. 
  # We aren't giving the user a choice of data sources, but we could.
  dataSet <- paste("WWDI/",
                   # The country that was clicked.
                   as.character(clickedCountry()),
                   # The time series that was chosen in the sidebar.
                   as.character(indicatorValue()), 
                   sep = "")
  # Now pass that pasted data set code object to Quandl.
  Quandl(dataSet, type = "xts")
})

We now have an object called countryData that is an xts object imported from Quandl. It holds the time series (1) from the WWDI data source, (2) for the country that was clicked, (3) for the economic indicator that was chosen in the sidebar

From a data import perspective, we’re done. We could fit a model to this data, run forecasts, etc., but I am going to head straight to visualization using highcharter.

As mentioned at the outset, dygraph would have done a fine job here, but highcharter seems to be a more popular visualization tool in the financial industry, and that’s a good reason to start exploring its capabilities.

The code chunk below might look heavy, but most of the lines are for aesthetics, creating a nice title and removing scroll bars that seem clunky to me. The key substantive statements below are highchart(type = "stock") and hc_add_series(countryData()).

The first statement tells highcharter to use its built-in stock format (this is good for graphing all sorts of economic time series, not just stocks), and the second passes our data object to the graphing function hc_add_series. It’s a well-named function because it adds a series to the chart. If we wanted to include another series, we would use that same function and pass in another xts object.

output$highchart <- renderHighchart({
  
  # Make a nice title for the chart.
  # The next three linese are purely aesthetic to that our graph has an intuitive
  # title. 
  indicatorName1 <- names(dataChoices[dataChoices == input$indicatorSelect])
  countryName1 <- countrycode(as.character(clickedCountry()), "iso3c", "country.name")
  title <- paste(countryName1, indicatorName1, sep = " ")
  
  # Call highchart and ask nicely for it to use the built-in 'stock' format.
  highchart(type = "stock") %>% 
    hc_title(text = title) %>%
    # Pass our time series object countryData to highcharter function hc_add_series.
    hc_add_series(countryData(), name = title) %>%
    # I don't like the look of the navigator/scrollbar in a small space, but others might. 
    # Change these to enabled = TRUE and check out the results.
    hc_navigator(enabled = FALSE) %>% 
    hc_scrollbar(enabled = FALSE)
})

That’s all for today. This post completes what we can retrospectively consider our 3-part series of Quandl Shiny apps. The other two posts are here and here. There are definitely interesting ways to combine the functionalities in these apps, but I’ll leave that to the awesome community of Shiny developers.

See you next time, when we visit the wonderful world of portfolio theory and volatility!

Sector Correlations

Wed, 18 Jan 2017 00:00:00 +0000

Welcome to the first installation of reproducible finance for 2017. It’s a new year, a new President takes office soon, and we could be entering a new political-economic environment. What better time to think about a popular topic over the last few years: equity correlations. Elevated correlations are important for several reasons - life is hard for active managers and diversification gains are vanishing - but I personally enjoy thinking about them more from an inference or data exploration perspective. Are changning correlations telling us something about the world? Are sectors diverging? How much can be attributed to the Central Bank regime at hand? So many questions, so many hypotheses to be explored. Let’s get started.

Today, we will build a Notebook and start exploring the historical rolling correlations between sector ETFs and the S&P 500. That is, we want to explore how equity returns in different sectors have been correlated with the returns of the broader index. Perhaps they are all moving in lockstep, perhaps they have been diverging. Either way, this Notebook will be the first step toward an flexdashboard that lets us do more interactive exploration - choosing different sector ETFs and rolling windows.

We are going to accomplish a few things today. We will load up the sector ETF tickers, then build a function to download their price history and calculate weekly returns. We will save this to one xts object. Next we will build a function to calculate the rolling correlations between a chosen sector ETF and the S&P 500. Finally, dygraphs will make its usual appearance to help visualize the rolling correlation time series.

As usual, we will be living in the Rmarkdown world and, by way of disclaimer, the data import and return calculation functions here should be familiar from previous posts. That is by design and hopefully, it won’t be too boring for devotees of this series (I know you’re out there somewhere!). More importantly, I hope the usefulness of reproducible, reusable code is emerging. Some of the code chunks in previous posts might have seemed trivially simple, containing just a simple function and little else. But, the simplicity of those code chunks made it very easy to return to those previous scripts, understand the functions, and use them in this post.

Let’s load up a few packages.

library(dplyr)
library(quantmod)
library(dygraphs)

Now, we need the tickers and sectors for the sector ETFs. They are copied below and available here. I deleted the XLRE real estate ETF because it’s only been around since 2015 and I want look back several years in this Notebook.

# List of tickers for sector etfs. 
# Omit XLRE because its inception is 2015. Not really enough to check out long term monthly correlations. 

ticker <- c("XLY", "XLP", "XLE",    "XLF", "XLV",   
            "XLI", "XLB", "XLK", "XLU", "SPY")  

# And the accompanying sector names for those ETFs.

sector <- c("Consumer Discretionary", "Consumer Staples", 
            "Energy", "Financials", "Health Care", "Industrials", 
            "Materials", "Information Technology", "Utilities", "Index")

etf_ticker_sector <- data_frame(ticker, sector)

etf_ticker_sector

## # A tibble: 10 × 2
##    ticker                 sector
##     <chr>                  <chr>
## 1     XLY Consumer Discretionary
## 2     XLP       Consumer Staples
## 3     XLE                 Energy
## 4     XLF             Financials
## 5     XLV            Health Care
## 6     XLI            Industrials
## 7     XLB              Materials
## 8     XLK Information Technology
## 9     XLU              Utilities
## 10    SPY                  Index

We’ve got our dataframe of tickers and sectors. Let’s build a function to download price history and then convert those price histories to weekly returns. We’ll use a combination of getSymbols() and periodReturn() to accomplish that. If you want to change this script to use daily returns, change the argument below to period = ‘daily’, but be prepared to import quite a bit more data.

# A function to build an xts object of etf returns.

etf_weekly_returns <- function(ticker) {
    
symbols <- getSymbols(ticker, auto.assign = TRUE, warnings = FALSE)

etf_prices <- do.call(merge, lapply(symbols, function(x) Cl(get(x))))
    
etf_returns <- do.call(merge, lapply(etf_prices, 
                                     function(x) periodReturn(x, period = 'weekly', type = 'log')))

#Change the column names to the sector names from our dataframe above.

colnames(etf_returns) <- etf_ticker_sector$sector
    
etf_returns

}

# Let's pass in our ticker symbols and build an xts object of etf returns
etf_returns <- etf_weekly_returns(etf_ticker_sector$ticker)

##     As of 0.4-0, 'getSymbols' uses env=parent.frame() and
##  auto.assign=TRUE by default.
## 
##  This  behavior  will be  phased out in 0.5-0  when the call  will
##  default to use auto.assign=FALSE. getOption("getSymbols.env") and 
##  getOptions("getSymbols.auto.assign") are now checked for alternate defaults
## 
##  This message is shown once per session and may be disabled by setting 
##  options("getSymbols.warning4.0"=FALSE). See ?getSymbols for more details.

## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols

head(etf_returns)

##            Consumer Discretionary Consumer Staples       Energy
## 2007-01-05           -0.007034027     -0.005722007 -0.011733539
## 2007-01-12            0.026062578      0.014055350 -0.008620725
## 2007-01-19            0.008875499      0.003765102  0.020354264
## 2007-01-26           -0.019888442     -0.004519819  0.004760584
## 2007-02-02            0.022409825      0.011634547  0.030830343
## 2007-02-09           -0.006315545     -0.010502685 -0.004101903
##              Financials  Health Care  Industrials     Materials
## 2007-01-05 -0.011167160  0.005655589 -0.007693470 -0.0113323889
## 2007-01-12  0.013331718  0.017361037  0.017579216  0.0290876947
## 2007-01-19 -0.001081666  0.011312637  0.001123511  0.0152115609
## 2007-01-26 -0.003795098 -0.012772249 -0.011577145  0.0086291974
## 2007-02-02  0.015362168  0.014501414  0.027452705  0.0151288535
## 2007-02-09 -0.005901386 -0.005485765 -0.009439299 -0.0008194183
##            Information Technology    Utilities        Index
## 2007-01-05            0.007260335 -0.019471313 -0.005888436
## 2007-01-12            0.021886396 -0.006668599  0.019029484
## 2007-01-19           -0.027005903  0.005005572 -0.002936435
## 2007-01-26           -0.001283929  0.005532545 -0.004842978
## 2007-02-02            0.016985546  0.023177534  0.018680358
## 2007-02-09           -0.008881386  0.025021348 -0.006025965

This function has done some good work for us and it was refreshingly comfortable to put in place because we used very similar functionality in this post and this post.

A pattern seems to be emerging in these Notebooks: grab tickers, get price history, convert to returns and save new xts object. In an ideal world, that pattern of data import and conversion is getting so familiar as to be commonplace.

That said, enough with the commonplace stuff - let’s get on to something a little more dangerous: rolling correlations amongst etf returns. Correlations are important because high correlations make it hard to find diversification opportunities and they make it hard to deliver alpha - though I suppose it’s always hard to deliver alpha. Fortunately, we don’t have to worry about generating alpha today so let’s get to our function.

Calculating rolling correlations in R is pretty straightforward. We use the rollapply() function, along with the cor() function, pass in our data and a time window, and it’s off to the races. We’ll create our own function below to handle these jobs and return an xts object.

# A function that calculates the rolling correlation between a sector ETF and the SPY SP500 ETF. 

sector_index_correlation <- function(x, window) {
  
    merged_xts <- merge(x, etf_returns$'Index')

    merged_xts$rolling_test <- rollapply(merged_xts, window, 
                                         function(x) cor(x[,1], x[,2], use = "pairwise.complete.obs"), 
                                         by.column = FALSE)
    
    names(merged_xts) <- c("Sector Returns", "SPY Returns", "Sector/SPY Correlation")
    
    merged_xts
}

Notice that this function does something that seems unnecessary: it creates a new xts object that holds the sector returns, SPY returns and the rolling correlation. We don’t have much use for that separate object and could probably have just added columns to our original xts object. Indeed, if this were our final product we might spend more time eliminating its present. I choose not to do that here for two reasons. First, this Notebook is built to underlie a flexdashboard that could go into production. I want to get the logic right here, then focus more on efficiency in the final app.

Second, and relatedly, we are prioritizing clarity of workflow in this Notebook. It should be crystal clear how we are moving from an xts object of ETF returns to creating a new XTS object of two returns plus one correlation. The goal is for any collaborators, including my future self, to open this Notebook and see the workflow. If that collaboarator finds this step to be unnecessary and has a more clever solution - that’s fantastic because it means this document is intellegible enough to serve as the basis for more sophisticated work.

Let’s go ahead and use this function. We will pass in a time series of Information Technology ETF returns and a window of size 20 for the rolling correlation.

# Choose a sector ETF and a rolling window and pass them to the function we just build. 
# Let's go with a 5 month window and the Information Technology sector.
# We will now have a new xts object with 3 time series: sector returns, SPY returns
# and the rolling correlation between those return series.

IT_SPY_correlation <- sector_index_correlation(etf_returns$'Information Technology', 20)

# Have a peek. The first 20 rows in the correlation column should be 
# NAs. 

head(IT_SPY_correlation, n = 25)

##            Sector Returns   SPY Returns Sector/SPY Correlation
## 2007-01-05    0.007260335 -0.0058884356                     NA
## 2007-01-12    0.021886396  0.0190294841                     NA
## 2007-01-19   -0.027005903 -0.0029364349                     NA
## 2007-01-26   -0.001283929 -0.0048429782                     NA
## 2007-02-02    0.016985546  0.0186803576                     NA
## 2007-02-09   -0.008881386 -0.0060259646                     NA
## 2007-02-16    0.015177315  0.0123590071                     NA
## 2007-02-23    0.003341691 -0.0029549759                     NA
## 2007-03-02   -0.057501940 -0.0467035959                     NA
## 2007-03-09    0.015776007  0.0151013857                     NA
## 2007-03-16   -0.002176236 -0.0161114796                     NA
## 2007-03-23    0.026656737  0.0344812823                     NA
## 2007-03-30   -0.010663355 -0.0097411262                     NA
## 2007-04-05    0.022892097  0.0156515560                     NA
## 2007-04-13    0.001256461  0.0074596420                     NA
## 2007-04-20    0.014131615  0.0224544236                     NA
## 2007-04-27    0.015561370  0.0061043558                     NA
## 2007-05-04    0.016122840  0.0092528469                     NA
## 2007-05-11    0.007171385 -0.0003976208                     NA
## 2007-05-18    0.004752405  0.0115988780              0.8820099
## 2007-05-25   -0.004752405 -0.0061121613              0.8963962
## 2007-06-01    0.018096442  0.0156329832              0.8946237
## 2007-06-08   -0.012159397 -0.0199273050              0.9301269
## 2007-06-15    0.017214861  0.0133507228              0.9311254
## 2007-06-22   -0.009744766 -0.0166001040              0.9302817

Alright, the function seems to have succeeded in building that new xts object and storing the rolling correlation. Now we will use dygraphs to visualize this rolling correlation over time and see if anything jumps out as interesting or puzzling.

# Let's graph the sector/index rolling correlation using our old friend dygraphs. 
# I'll add an event for the financial crisis and shade the recession of 2007-2009 with 
# an unimposing pink hue.

dygraph(IT_SPY_correlation$'Sector/SPY Correlation', main = "Correlation between SP500 and Tech ETF") %>% 
    dyAxis("y", label = "Correlation") %>% 
    dyRangeSelector(height = 20) %>%
    dyShading(from = "2007-12-01", to = "2009-06-01", color = "#FFE6E6") %>% 
    dyEvent(x = "2008-09-15", label = "Fin Crisis", labelLoc = "top", color = "red")

The correlation between the Tech ETF and the S&P 500 ETF seems quite high. It dipped a bit in the middle of 2009 and again towards the end of 2016. It would be interesting to see if this was true of the other sector ETFs as well. In other words, were these periods of generally declining correlations, or was it limited to the technology/SP500 relationship?

The best way to do some exploratory analysis on that is, no surprise, build a shiny app that allows users to choose their own sectors and rolling windows. We’ll do that next time - see you in a few days!