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.

Downtime Reading

Fri, 29 Dec 2017 00:00:00 +0000

Not everyone has the luxury of taking some downtime at the end the year, but if you do have some free time, you may enjoy something on my short list of downtime reading. The books and articles here are not exactly “light reading”, nor are they literature for cuddling by the fire. Nevertheless, you may find something that catches your eye.

The Syncfusion series of free eBooks contains more than a few gems on a variety of programming subjects, including James McCaffrey’s R Programming Succinctly and Barton Poulson’s R Succinctly.

For a more ambitious read, mine the rich vein of SUNY Open Textbooks. My pick is Hiroki Sayama’s Introduction to the Modeling and Analysis of Complex Systems.

If you just can’t get enough of data science, then a few articles that caught my attention are:

Christopher Olah’s brief but mind-stretching post on Neural Networks, Manifolds, and Topology, which is good preparation for the Fujitsu Laboratories paper on Time Series Classification via Topological Data Analysis
The paper by Nguyen and Holmes on their Bayesian Unidimensional Scaling (BUDS) method for detecting patterns in high-dimensional data
Bou-Hamad et. al’s A review of survival trees, a valuable introduction to the literature on the subject
Rob Hyndman’s recent post on Some new time series packages
Mike Bostock’s beautiful and mind-altering post on Visualizing Algorithms.

Finally, if you really have some time on your hands, try searching through the 318M+ papers on PDFDRIVE.

Happy reading, and have a Happy and Prosperous New Year from all of us at RStudio!!

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.

Copper, Gold and Ten-Year Treasury Notes

Wed, 12 Apr 2017 00:00:00 +0000

Today, we will continue getting familiar with data from Quandl, but will also devote more time to expanding our dygraphs toolkit. We will be building up a data visualization in discrete pieces, which isn’t very efficient, but will make things easier when we move this project into production as a Shiny app. From a substantive perspective, we will examine the relationship between the price ratio of copper-gold and 10-year Treasure yields.

Why do we care about the copper-gold price ratio and Treasury yields? First, both Jeff Gundlach (in this webcast) and Adam Robinson say so, and that’s probably good enough. The theory goes like this:

Copper is a useful industrial metal whose price tends to rise when the global economy expands. As firms produce more goods that require copper as an input, the increased demand for copper drives the price higher. Gold, on the other hand, is a somewhat less useful metal whose prices tends to rise when investors are fearful about a contracting global economy. Gold is a safe-haven investment, and a rising gold price signals either a contracting economy, investor fears of a contracting economy, or both. Gold prices tend to fall when the economy is humming along nicely. Thus, the copper-gold price ratio tends to be increasing when the economy is expanding.

The yield on 10-year Treasury Notes also tends to rise during economic expansion because investors’ inflation expectations are on the rise. When investors expect inflation to increase, they anticipate an uptick in interest rates (for those of you who are too young to remember what an interest rate is, take a look at rates in the mid-1980s) and start to seek higher yields today. That can drive down Treasury prices and increase yields.

Thus, we should observe a positive relationship between the copper-gold price ratio and 10-year yields. Both should be rising and falling based on the state of the world economy. There’s nothing too crazy here, but it’s an interesting relationship to think about and investigate. That’s what we’ll do today!

First, let’s import the relevant time series data from Quandl. We will specify type = "xts" in order to create xts objects and collapse = "daily" because we want daily prices. Note in particular our data sources: CME for copper and gold, and FRED for the 10-year yield. But, we just need the Quandl codes and to be careful about consistent start/end dates for each data set. It’s a liberating feeling to know before starting a project that we’ll be able to find whatever data we need in one source.

Let’s get to it.

library(Quandl)
library(dplyr)
library(xts)
library(lubridate)
library(dygraphs)

copper <- Quandl("CHRIS/CME_HG1", type = "xts", collapse = "daily",  
                    start_date = "2012-01-01", end_date = "2017-02-28")

gold <- Quandl("CHRIS/CME_GC1", type = "xts", collapse = "daily",  
                    start_date = "2012-01-01", end_date = "2017-02-28")

ten_year <- Quandl("FRED/DGS10", type = "xts", collapse = "daily",  
                    start_date = "2012-01-01", end_date = "2017-02-28")

Now we want to combine these into one xts object, which normally would be an easy invocation of merge.xts, but there’s a slight wrinkle. After creating one xts object, we know we need to calculate a ratio of copper/gold. That means that the presence of NAs will be a problem (I found this out the old-fashioned way, by running code that threw an error). Let’s take care of that by prepending the na.locf() function to our merge operation. That function will replace all NAs with the previous day’s value. Why might one of our time series have an NA when another doesn’t? Maybe one of the instruments has a trading holiday, or FRED publishes data for days that are general market holidays.

The downside, of course, is that we are adding observed values that are fictional. I can live with that here since we’re creating a visualization to help understand and gain an intuition about the hypothesized copper-gold yield relationship. If we were using this data to create a trading strategy or algorithm, our NA replacement would be unacceptably fuzzy and a more rigorous decision-making process would be needed to synchronize the data sets.

No matter which approach is taken, the most crucial thing is to explain and make easily reproducible whatever process is used for handling NAs or any data cleaning such as this. Your colleagues, future self, clients and research audience can scrutinize, discount, ignore or applaud it accordingly.

# We're going to merge our 3 xts objects into on xts objects. This would normally be
# very simple with merge.xts but we want to eliminat NAs with na.locf().

copper_gold_tenYear_merged <- na.locf(merge.xts(copper$Settle, gold$Settle, ten_year),
                                      formLast = TRUE)

colnames(copper_gold_tenYear_merged ) <- c("Copper", "Gold", "TenYear")

Now we create a new column to store the ratio of copper gold prices.

# Create the ratio of prices. I multiply copper by 100 to synch with the scale used by 
# Gundlach in his presentation.
copper_gold_tenYear_merged$ratio <- (copper_gold_tenYear_merged$Copper*100)/copper_gold_tenYear_merged$Gold

We have an xts object that holds four time series, but I want to chart only the copper-gold price ratio and 10-year yields. This next step is not necessary but to be extra clear, I am going to create a new xts object to hold only those two time series.

tenYear_ratio  <- merge(copper_gold_tenYear_merged$ratio, copper_gold_tenYear_merged$TenYear)

We use dygraphs to chart that one xts object, and call dySeries() for each of the columns to be included.

dygraph(tenYear_ratio) %>%
  dySeries("ratio") %>% 
  dySeries("TenYear")

That chart is completely unhelpful, of course, because our time series have different scales. I also don’t love the choppiness of the blue 10-year chart. Let’s address these two issues by adding a right-hand side scale and a dyRoller().

The dyRoller() will help smooth out our chart because each plotted point will be an average of the number of periods specified with rollPeriod = X. This won’t affect our xts object, where we store the data, it just makes the chart more readable.

Adding the right-hand-side y-axis requires a few more lines of code. First we need to invoke dyAxis() for the left-hand axis, called “y”. Then we invoke dyAxis() for the right-hand axis, called “y2”. We also need to set independentTicks = TRUE so that we can use a unique, independent value scale for the right-hand side. Next, in our dySeries() call for each time series, we assign each one to an axis. Here we assign “ratio” with axis = 'y', so that the copper-gold price ratio will be on the left-hand scale, and we assign “TenYear” with axis = 'y2', so the 10-year yield will be on the right-hand scale. I also like to include a label with LHS and RHS for each time series.

dygraph(tenYear_ratio) %>% 
  # Add the rollPeriod for smoothing.
  dyRoller(rollPeriod = 3) %>% 
  # Create two independent axes.
  dyAxis("y", label = "USD") %>%
  dyAxis("y2", label = "Percent (%)", independentTicks = TRUE) %>%
  # Assign each time series to an axis.
  dySeries("ratio", axis = 'y', label = "Copper/Gold (LHS)") %>% 
  dySeries("TenYear", axis = 'y2', label = "10-Year % Yield (RHS)")

Alright, that chart looks better now (though I encourage you to play with different settings for rollPeriod to compare different smoothness levels) and, incidentally, seems supportive of our hypothesized relationship between copper-gold and yields. There did seem to be a few periods of divergence, which would be a ripe area for further research. But we will move on to calculate and chart the rolling correlation between these two time series.

Recall way back to this post from January where we examined rolling correlations between sector ETFs. We’ll port our work from that project and use rollyapply to calculate the 90-day rolling correlation between copper-gold and yields. We will also rename the column since it will be displayed on the dygraph.

# Calculate the rolling correlation between copper-gold and Treasury yields. 

rolling_cor <- rollapply(tenYear_ratio, 90, 
                                       function(x) cor(x[, 1], x[, 2], use = "pairwise.complete.obs"), 
                                       by.column = FALSE)

names(rolling_cor) <- "Copper/Gold 10-Year Correlation"

Let’s graph that rolling correlation.

dygraph(rolling_cor, main = "Rolling 90-day Correlation Copper-Gold & 10-Year Yield")

It looks like the correlation has been above .4 for the last year and on the increase since the election in November. Peeking back up at the chart of the copper-gold ratio and yields, both those time series have been on the rise since the election as well. Investors seem bullish on the economy and an increase in interest rates.

We can add further context with the minimum, maximum and mean rolling correlations and an event label for the election. Nothing complicated here but it’s a good use of the dyLimit() and dyEvent() functions.

  avg <- round(mean(rolling_cor,  na.rm = T), 2)

  mini <- round(min(rolling_cor,  na.rm = T), 2)
 
  maxi <- round(max(rolling_cor,  na.rm = T), 2)
  
dygraph(rolling_cor, main = "Rolling 90-day correlations Copper-Gold & 10-Year Yield") %>% 
  dyLimit(avg, color = 'purple') %>% 
  dyLimit(mini, color = 'red') %>% 
  dyLimit(maxi, color = 'blue') %>% 
  dyEvent("2016-11-08", "Trump!", labelLoc = "bottom")

That’s all for today. We have examined a hypothesized relationship and found some confirmatory evidence, or at least visual indicators. We have also explored some new tools in the dygraphs world by using dyRoll() and dyAxis(). From a workflow and reproducibility perspective, I like this as a template for importing multiple time series and visualizing the relationship between them in different combinations. When we wrap this into a Shiny app next time, we will see how this can be useful for further exploration. Thanks and see you next time!