Visualizations on R Views

Wonderful Wednesdays

Mon, 11 Jan 2021 00:00:00 +0000

For almost a year now, the PSI Visualization Special Interest Group (VIS SIG) has been conducting a monthly graduate-level seminar on creating effective statistical visualizations that is open to everyone. Wonderful Wednesdays is a unique collegial event. Every month the SIG publishes a link to a new data set and issues a challenge to produce visualizations that effectively illustrate some specific aspects of the data. Anyone can submit an entry coded in the language of their choice. Submissions that are received by the deadline are then critiqued in free webinar that takes place roughly thirty days later. You don’t have to make a submission to attend the webinar.

The process is well organized and straightforward. The figure below illustrates the process and time liness for the for the webinar that will happen this week on Wednesday, January 13th.

Click here to register for the webinar.

Here is the link to the December webinar where the challenge was to visualize the heterogeneity among the data used for a meta-analysis of seven studies undertaken to show a reduction in hypertension.

The following image is a traditional forest plot showing a comparison of the odds ratios for the seven studies. (If you are not familiar with this plot type look here for some tips on how to interpret it.)

This image comes from a shiny app that is critiqued at the by the VIS-SIG statisticians towards the beginning of the webinar. The experts liked the clean look and labeling on the plot, but had mixed feelings about the colored bands which are meant to show regions where the studies overlap. (Darker color indicates more overlap.) Here are the links to the Shiny App and the code and also to the blog post that reviews all of the submissions for the December challenge.

Visit the VIS-SIG Blog to finds posts and code for the submissions for all of Wonderful Wednesday events so far.

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.

Shiny in Medicine

Wed, 03 May 2017 00:00:00 +0000

Shiny Apps are becoming ubiquitous as a way for data scientists to present the results of an analysis, and also to engage with information consumers who may not be coders. The trend I see is that the greater the variety of skills and interests of the information consumers for any particular project, the more valued are interactive visualizations that can be integrated into enterprise-wide communication workflows. So, it is not surprising to see Shiny apps popping up in all manner of healthcare and medical applications. If data scientists are going to bring predictive analytics into clinical workflows where doctors, nurses, scientists, technicians and administrators are all part of near real-time decision processes, they are going to have to be even more inventive in providing these multi-skilled teams with low-friction tools to ingest and manipulate information. Below are few interesting Shiny apps that are broadly related to Health Care and Medicine. My guess is that interactive visualizations like these will improve research and clinical workflows, and eventually change how all of us look at Health Care and Medicine.

The Genome viewer for ICGC cancer, built by the folks at Aridhia, is geared towards researchers. You can learn how to interpret the plot and learn the story behind its creation here.

The Emergency Department Simulation, built by a group of mathematicians and physicians, models patient flow information under different assumptions about emergency department case loads, and illustrates how predictive analytics and statistical analysis can be integrated into operational clinical workflows.

The Colorectal Cancer risk calculator from the Cleveland Clinic targets physicians and the general public to personalize the risk of this disease. I found working through different “what if” scenarios of great help in thinking about the risk factors that are under my control.

Finally, these two Shiny Apps that provide information about US hospitals should be of interest to public health planners, as well as to the general public. The Hospital Ranking App compares hospital outcomes for heart attack, heart failure, and pneumonia against national statistics.

The Access to Hospital Care Dashboard plots the density of hospitals throughout the United States, and indicates under-served areas.

If you or your team are doing this kind of work, we here at R Views would love to hear about it.

Reproducible Finance with R: ETF Country Exposure

Wed, 08 Feb 2017 00:00:00 +0000

Today, we are going to tackle a project that has long been on my wishlist - a Shiny app to take a fund or portfolio, analyze its exposure to different countries and display those exposures on a world map. Now you know how exciting my wishlists are.

Before describing our data importing/wrangling work here in the Notebook, it mgight be helpful to look at where we’re headed. The final Shiny app is here. This is similar to a previous project because we are building a leaflet map, shading according to data that we add to the spatial dataframe, and including another HTML widget that is reponsive to the map. However, our current project differs in important ways and has a completely different use.

The previous project allowed user to click a country on the map and view the time series of returns. Our current project will allow the user to choose an ETF and view how that ETF is invested in different countries by how a world map is shaded.

From a substantive perspective, this app helps visualize country risks instead of returns - indeed, it’s the first in our series that does not import stock returns in any way. From an R perspective, in our current project the map is the responsive object according to user inputs, whereas before the dygraph was the responsive object according to user clicks on a map. They are related and require spatial dataframes but very different.

If you looked closely at the Shiny app, you noticed that we do have a data object that os responsive to a map click: we display a datatable of companies held by the ETF in whatever country is clicked. That is, if a user chooses an ETF and sees by the shading that the ETF is allocated X% to China, the user can click on the map to see which companis the ETF owns in China. That functionality is similar to the dygraphs functionality, except of course we have to wire up a datatable and do some filtering by country instead of passing an xts object to dygraphs. The fulcrum will still be the clicked map shape.

Alright, that app is what we’re ultimately building but, by way of what we’ll do in this Notebook, here’s the roadmap.

First, we are going to grab the data for one fund, the MSCI Emerging Markets ETF. Note that we are not going to get return data over time. Instead, we just want a snapshot of the ETF holdings: its constituents, their weights and their home countries. Our eventual app will include several ETFs but we are going to work with one ETF in this Notebook, with the foreknowledge that we want to reuse our steps when it’s time to build the Shiny app. In short, let’s get it right for this Emerging Markets ETF and then we can iterate over other ETFs when we move to building our Shiny app.

After we download the snapshot of the emerging markets fund, we will do some wrangling, some country weight aggregation, and then merge that data to our spatial dataframe. Adding that data will depend on the ETF using the same country naming convention as our spatial dataframe, so we’ll pay attention to that in the wrangling process.

Once we add the data to our spatial dataframe, we will recycle some old code, build a leaflet map and shade it according to the ETF’s country exposure. This is just a test to see how things will look in the Shiny app and we can even play around with different color palettes to get things just right.

Once we have the map aesthetics sorted, we’ll turn to part two: displaying the details of each country holding. Really this is just filtering our dataframe by country name - whatever country the user clicks - but we’ll go ahead and make sure things look how we want in this Notebook and then pass that object to our app eventually.

Let’s get to it!

First, let’s grab the fund data from MSCI’s homepage. We will use the read_csv() function from the readr package. We will title it emerging_markets_fund since we’ll be pulling in other funds later.

Note that we have to skip the first 10 rows, which is why the ‘skip = 10’ argument is included. That’s because this csv file is loaded with oddly formatted data in the first 10 rows. If we don’t skip those 11 rows, this import will be totally unhelpful. The ‘import dataset’ button in the IDE saved me minutes/hours of frustration here! (Author’s note: when this post was originally published, this argument was “skip = 11”. A few weeks later, ishares changed the structure of their spreadsheet. Now it’s 10 rows that need to be skipped!)

# Download the Emerging Markets ETF fund data from the ishares homepage.

emerging_market_fund <- read_csv("https://www.ishares.com/us/products/239637/ishares-msci-emerging-markets-etf/1467271812596.ajax?fileType=csv&fileName=EEM_holdings&dataType=fund", 
    skip = 10)

# Take a look at the fund snapshot we just imported. 
head(emerging_market_fund)

## # A tibble: 6 × 16
##   Ticker                               Name `Asset Class` `Weight (%)`
##    <chr>                              <chr>         <chr>        <dbl>
## 1 005930            SAMSUNG ELECTRONICS LTD        Equity       4.1165
## 2    700               TENCENT HOLDINGS LTD        Equity       3.6649
## 3   2330 TAIWAN SEMICONDUCTOR MANUFACTURING        Equity       3.5112
## 4   BABA ALIBABA GROUP HOLDING ADR REPRESEN        Equity       2.7304
## 5    NPN              NASPERS LIMITED N LTD        Equity       1.7600
## 6    939     CHINA CONSTRUCTION BANK CORP H        Equity       1.5572
## # ... with 12 more variables: Price <dbl>, Shares <dbl>, `Market
## #   Value` <chr>, `Notional Value` <chr>, Sector <chr>, SEDOL <chr>,
## #   ISIN <chr>, Exchange <chr>, Country <chr>, Currency <chr>, `Market
## #   Currency` <chr>, `FX Rate` <dbl>

Alright, we have our fund data and now the wrangling begins. We are actually going to use this initial object to create two other objects: one will be merged with the spatial dataframe and one will be a standalone object to be loaded in our Shiny app.

emerging_market_fund_country_weights <- emerging_market_fund %>% 
  select(Country, `Weight (%)`) %>%
  mutate(Country = replace(Country, Country == "Russian Federation", "Russia"), 
         Country = replace(Country, Country == "Korea (South)", "Korea"),
         Country = replace(Country, Country == "KO", "Korea"),
         Country = replace(Country, Country == "Czech Republic", "Czech Rep.")
         ) %>%
  group_by(Country) %>% 
  summarise(EEM = sum(`Weight (%)`, na.rm = TRUE)) %>% 
  rename(name = Country) %>% 
  filter(EEM > 0) %>% 
  filter(name != "-") %>% 
  arrange(desc(EEM))

# Let's just take a look at the data.

emerging_market_fund_country_weights

## # A tibble: 28 × 2
##            name     EEM
##           <chr>   <dbl>
## 1         China 26.2637
## 2         Korea 14.9220
## 3        Taiwan 12.1916
## 4         India  8.5008
## 5        Brazil  7.4449
## 6  South Africa  6.7359
## 7        Russia  3.7714
## 8        Mexico  3.6169
## 9     Indonesia  2.4890
## 10     Malaysia  2.4130
## # ... with 18 more rows

Those country weights are pretty striking. China + Korea + Taiwan equal 51% of this fund - quite concentrated in economies that are probably closely linked. Perhaps that’s by design? Perhaps the inter-economy correlation isn’t as high as I believe? A cross-border investment or trade Shiny app would be helpful here.

It’s worth a second to consider the definition of ‘emerging market’, a term that has become quite ubiquitous and has a know-it-when-we-see-it feel (if you’re not into political economy, feel free to skip this paragraph). The phrase was coined in 1981 by the World Bank’s Antoine Van Agtmael to help encourage investment in developing nations as he felt that ‘Third World’ country was both distasteful and stifling to investors. Learn more here. Today, the phrase connotes an economy that is growing and transitioning from developed to developing, though some commentators include a political transition as well. Since we are working with an MSCI fund, we should consider their definition. It wasn’t easy to track down, but according to the Financial Times, MSCI takes into account number of listed companies of a certain size (an economic measure) and openness to foreign capital (a political measure).

Back to our task at hand: we have downloaded the fund data and got it into shape to be added to our shapefile. That process is the exact same as in our previous post so before we do that, let’s use the original fund data to create one other object, to store country level detail on companies, weights and sectors. If that seems a bit confusing, head back to the Shiny app and click on a country. The datatable displays company names and details, and we need to create a dataframe to extract and hold that data.

# Wrangle for the datatable to show company names, sector, weights.

EEM <- emerging_market_fund %>% 
  select(Name, Country, Sector, `Weight (%)`, `Market Value`) %>% 
  mutate(Country = replace(Country, Country == "Russian Federation", "Russia"), 
         Country = replace(Country, Country == "Korea (South)", "Korea"),
         Country = replace(Country, Country == "Czech Republic", "Czech Rep.")
         ) %>% 
  filter(`Weight (%)` > 0) %>% 
  filter(Country != "-") 

# Let's test it on Brazil to make sure it works.

Brazil_companies <- EEM %>%
  filter(Country == "Brazil") %>% 
  ungroup() %>% 
  select(-Country)

Brazil_companies

## # A tibble: 59 × 4
##                                  Name           Sector `Weight (%)`
##                                 <chr>            <chr>        <dbl>
## 1       ITAU UNIBANCO HOLDING PREF SA       Financials       0.8775
## 2              BANCO BRADESCO PREF SA       Financials       0.6219
## 3                            AMBEV SA Consumer Staples       0.5881
## 4                        VALE PREF SA        Materials       0.3817
## 5         PETROLEO BRASILEIRO PREF SA           Energy       0.3808
## 6                           PETROBRAS           Energy       0.3028
## 7             CIA VALE DO RIO DOCE SH        Materials       0.2701
## 8   ITAUSA INVESTIMENTOS ITAU PREF SA       Financials       0.2668
## 9  BMF BOVESPA BOLSA DE VALORES MERCA       Financials       0.2312
## 10                BANCO DO BRASIL S/A       Financials       0.2039
## # ... with 49 more rows, and 1 more variables: `Market Value` <chr>

This is what a user of our Shiny app will see upon clicking on Brazil, it is the country level detail of how the fund is invested in Brazil. We will save that ‘EEM’ object in the .RDat file so it can be loaded into our Shiny app.

Okay, let’s go ahead and build that map of the world and add our fund country weights to it. This process is identical to how we did it here, but we’ll go through the steps again.

First, let’s download the spatial dataframe. We will also use the ms_simplify() function from rmapshaper to reduce the size of the dataframe. This function will reduce the number of longitude and latitude coordinates used to build each country. It will make loading faster in our Shiny app but won’t affect any of our logic.

library(rgdal)
library(rmapshaper)
library(httr)

# Load the spatial dataframe
tmp_zipped <- tempfile()
tmp_unzipped <- tempfile()

httr::GET("http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/50m/cultural/ne_50m_admin_0_countries.zip", write_disk(tmp_zipped))

## Response [http://naciscdn.org/naturalearth/50m/cultural/ne_50m_admin_0_countries.zip]
##   Date: 2017-03-24 17:31
##   Status: 200
##   Content-Type: application/x-zip-compressed
##   Size: 818 kB
## <ON DISK>  /var/folders/np/13n2s4g91vsgv7y432b5wf_00000gn/T//RtmplAXIku/file106cc57ce68bd

unzip(tmp_zipped, exdir = tmp_unzipped)

world <- readOGR(tmp_unzipped, 'ne_50m_admin_0_countries', verbose = FALSE)

# Use ms_simplify to reduce the size of the spatial dataframe.
world <- ms_simplify(world)

Now we will use the merge() function from the sp package to add our country weight data. Remember above where we made sure to use a consistent country naming convention when wrangling the ETF data? This is where it will come in handy - we use the ‘name’ column to perform the merge. After the merging, ETF exposures will be added for each country that has a match in the ‘name’ column. For those with no match, the EEM column will be filled with NA.

library(sp)
library(leaflet)

world_fund_country_weights <- merge(world, emerging_market_fund_country_weights, by = "name") 

# Let's take a look and make sure that merge accomplished what we want. There will be
# several NA values, because this fund is allocated only to emerging markets. The developed markets
# should be mostly NAs - Australia is immediately visible to us as an NA.
world_fund_country_weights@data[c('name', 'EEM')]

##                     name     EEM
## 1            Afghanistan      NA
## 4                 Angola      NA
## 2                Albania      NA
## 162 United Arab Emirates  0.7672
## 6              Argentina      NA
## 7                Armenia      NA
## 5             Antarctica      NA
## 8              Australia      NA
## 9                Austria      NA
## 10            Azerbaijan      NA
## 24               Burundi      NA
## 13               Belgium      NA
## 15                 Benin      NA
## 23          Burkina Faso      NA
## 11            Bangladesh      NA
## 22              Bulgaria      NA
## 18      Bosnia and Herz.      NA
## 12               Belarus      NA
## 14                Belize      NA
## 17               Bolivia      NA
## 20                Brazil  7.4449
## 21                Brunei      NA
## 16                Bhutan      NA
## 19              Botswana      NA
## 28  Central African Rep.      NA
## 27                Canada      NA
## 149          Switzerland  0.0814
## 30                 Chile  1.2210
## 31                 China 26.2637
## 35         Côte d'Ivoire      NA
## 26              Cameroon      NA
## 40       Dem. Rep. Congo      NA
## 33                 Congo      NA
## 32              Colombia  0.4224
## 34            Costa Rica      NA
## 37                  Cuba      NA
## 107            N. Cyprus      NA
## 38                Cyprus      NA
## 39            Czech Rep.  0.1802
## 58               Germany      NA
## 43              Djibouti      NA
## 42               Denmark      NA
## 44        Dominican Rep.      NA
## 3                Algeria      NA
## 45               Ecuador      NA
## 46                 Egypt  0.1191
## 49               Eritrea      NA
## 143                Spain      NA
## 50               Estonia      NA
## 51              Ethiopia      NA
## 54               Finland      NA
## 53                  Fiji      NA
## 52          Falkland Is.      NA
## 55                France      NA
## 56                 Gabon      NA
## 163       United Kingdom      NA
## 57               Georgia      NA
## 59                 Ghana      NA
## 63                Guinea      NA
## 64         Guinea-Bissau      NA
## 48            Eq. Guinea      NA
## 60                Greece  0.3025
## 61             Greenland      NA
## 62             Guatemala      NA
## 65                Guyana      NA
## 67              Honduras      NA
## 36               Croatia      NA
## 66                 Haiti      NA
## 68               Hungary  0.2818
## 71             Indonesia  2.4890
## 70                 India  8.5008
## 74               Ireland      NA
## 72                  Iran      NA
## 73                  Iraq      NA
## 69               Iceland      NA
## 75                Israel      NA
## 76                 Italy      NA
## 77               Jamaica      NA
## 79                Jordan      NA
## 78                 Japan      NA
## 136      Siachen Glacier      NA
## 80            Kazakhstan      NA
## 81                 Kenya      NA
## 85            Kyrgyzstan      NA
## 25              Cambodia      NA
## 82                 Korea 14.9220
## 83                Kosovo      NA
## 84                Kuwait      NA
## 86               Lao PDR      NA
## 88               Lebanon      NA
## 90               Liberia      NA
## 91                 Libya      NA
## 144            Sri Lanka      NA
## 89               Lesotho      NA
## 92             Lithuania      NA
## 93            Luxembourg      NA
## 87                Latvia      NA
## 104              Morocco      NA
## 101              Moldova      NA
## 95            Madagascar      NA
## 100               Mexico  3.6169
## 94             Macedonia      NA
## 98                  Mali      NA
## 106              Myanmar      NA
## 103           Montenegro      NA
## 102             Mongolia      NA
## 105           Mozambique      NA
## 99            Mauritania      NA
## 96                Malawi      NA
## 97              Malaysia  2.4130
## 108              Namibia      NA
## 111        New Caledonia      NA
## 114                Niger      NA
## 115              Nigeria      NA
## 113            Nicaragua      NA
## 110          Netherlands  0.3367
## 116               Norway      NA
## 109                Nepal      NA
## 112          New Zealand      NA
## 117                 Oman      NA
## 118             Pakistan      NA
## 120               Panama      NA
## 123                 Peru  0.3722
## 124          Philippines  1.1454
## 121     Papua New Guinea      NA
## 125               Poland  1.2310
## 127          Puerto Rico      NA
## 41       Dem. Rep. Korea      NA
## 126             Portugal      NA
## 122             Paraguay      NA
## 119            Palestine      NA
## 128                Qatar  0.7938
## 129              Romania      NA
## 130               Russia  3.7714
## 131               Rwanda      NA
## 169            W. Sahara      NA
## 133         Saudi Arabia      NA
## 145                Sudan      NA
## 132             S. Sudan      NA
## 134              Senegal      NA
## 137         Sierra Leone      NA
## 47           El Salvador      NA
## 141           Somaliland      NA
## 140              Somalia      NA
## 135               Serbia      NA
## 146             Suriname      NA
## 138             Slovakia      NA
## 139             Slovenia      NA
## 148               Sweden      NA
## 147            Swaziland      NA
## 150                Syria      NA
## 29                  Chad      NA
## 156                 Togo      NA
## 154             Thailand  2.2042
## 152           Tajikistan      NA
## 159         Turkmenistan      NA
## 155          Timor-Leste      NA
## 157              Tunisia      NA
## 158               Turkey  1.0363
## 151               Taiwan 12.1916
## 153             Tanzania      NA
## 160               Uganda      NA
## 161              Ukraine      NA
## 165              Uruguay      NA
## 164        United States  0.4507
## 166           Uzbekistan      NA
## 167            Venezuela      NA
## 168              Vietnam      NA
## 170                Yemen      NA
## 142         South Africa  6.7359
## 171               Zambia      NA
## 172             Zimbabwe      NA

We have our data added to the shapefile. Let’s go ahead and construct a map. First we’ll build a popup to show some detail, then we will create a green palette and a purple palette - for no other reason than to see which is more visually appealing.

# Create a popup to display the exact country weight.
EEMPopup <- paste0("<strong>Country: </strong>", 
                world_fund_country_weights$name,
                "<br><strong> Country Weight: </strong>", 
                world_fund_country_weights$EEM, "%")

# Let's create two palettes so we can look at two variants. This is pure aesthetics, but the Notebook is the
# place for aesthetics.

EEMPalGreens <- colorQuantile("Greens", world_fund_country_weights$EEM, n = 20)
EEMPalPurples <- colorQuantile("Purples", world_fund_country_weights$EEM, n = 20)

Let’s invoke leaflet! As before, we will use ‘layerId = ~name’. This is, again, massively important because when we create a Shiny app, we want to pass country names to our datatable and filter accoringly. The ‘layerId’ is how we’ll do that: when a user clicks on a country, we capture the ‘layerId’, which is a country name that can be used for filtering.

# Build a green shaded map.
leaf_world_emerging_greens <- leaflet(world_fund_country_weights) %>%
  addProviderTiles("CartoDB.Positron") %>% 
  setView(lng =  20, lat =  15, zoom = 2) %>%
      addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = .7,
                  
      # The next line of code is really important for creating the map we want to use later.
      
      color =~EEMPalGreens(EEM), layerId = ~name, popup = EEMPopup)

# Build a purple shaded map.
leaf_world_emerging_purples <- leaflet(world_fund_country_weights) %>%
  addProviderTiles("CartoDB.Positron") %>% 
  setView(lng =  20, lat =  15, zoom = 2) %>%
      addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = .7,
      color =~EEMPalPurples(EEM), layerId = ~name, popup = EEMPopup)

# Let's compare our green shaded map to our purple shaded map.
leaf_world_emerging_greens

leaf_world_emerging_purples

Both those maps look good to me but purple might be the way to go ultimately. That’s a decision for next time - see you then!

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!

Creating Interactive Plots with R and Highcharts

Wed, 19 Oct 2016 00:00:00 +0000

Sometimes great ideas come from trying to solve simple problems. This seems to be especially true for software developers who are willing to put in an unreasonable amount of effort to solve a simple problem to their satisfaction. So the story goes that Torstein Hønsi, the founder and Chief Product Officer of Highcharts. was looking for a simple charting tool for updating his homepage with snow depth measurements from Vikjafjellet, the local mountain where his family keeps a cabin. Frustrated with the common flash plug-ins, and other proprietary solutions available at the time, he decided to build a standards-based solution of his own and then, of course, share it.

In this post, I’ll use Joshua Kunst’s highcharter package, a wrapper for the Highcharts javascript library, along with Shiny to create some pretty slick plots.

Please note that all products in this library are free for non-commercial use. For use in commercial projects and websites, see https://shop.highsoft.com.

The highcharter package enables the creation of Highcharts type plots within R.

There are two main functions in the package:

highchart(): Creates a Highchart chart object using htmlwidgets. The widget can be rendered on HTML pages generated from R Markdown, Shiny, or other applications.
hchart(): Uses highchart() to draw a plot for different R object classes using a convenient single command. Specifically, it can plot data frames, numeric, histogram, character, density, factors, ts, mts, xts, stl, ohlc, acf, forecast, mforecast, ets, igraph, dist, dendrogram, phylo, and survfit classes.

Plots are built in the spirit of ggplot2 by layering, although they use the pipe operator (%>%) instead of +.

Other attractive features of the package are:

Theming: It is possible to configure your plots with pre-implemented themes like Economist, Financial Times, Google, and FiveThirtyEight among others.
Plugins: Motion, drag points, fontawesome, url-pattern, annotations.

We will demonstrate the functionality of this package as well as of Highcharts in general through a series of visualisation examples.

Example 1: US births on Friday the 13th

The inspiration for this visualization is a FiveThirtyEight article titled Some People Are Too Superstitious To Have A Baby On Friday The 13th. FiveThirtyEight generously makes the data used in (some of) their articles available on their GitHub repository. The data used in this particular analysis can be found here.

Our goal is to recreate this particular visualization. In order to do so, we need to calculate the differences between the number of births on the 13th and the average of 6th and 20th of each month, and aggregate these values for the days of the week. This is nothing a bit of dplyr and tidyr can’t handle.

Let’s load the necessary packages:

library(highcharter)
library(dplyr)
library(tidyr)

and the data

births <- read.csv("https://github.com/mine-cetinkaya-rundel/highcharts-in-r/raw/master/data/births.csv")

Then we’ll calculate the differences in births as described in the article and store the results in a new data frame called diff13:

diff13 <- births %>%
  filter(date_of_month %in% c(6, 13, 20)) %>%
  mutate(day = ifelse(date_of_month == 13, "thirteen", "not_thirteen")) %>%
  group_by(day_of_week, day) %>%
  summarise(mean_births = mean(births)) %>%
  arrange(day_of_week) %>%
  spread(day, mean_births) %>%
  mutate(diff_ppt = ((thirteen - not_thirteen) / not_thirteen) * 100)

which looks like:

diff13

## Source: local data frame [7 x 4]
## Groups: day_of_week [7]
## 
##   day_of_week not_thirteen  thirteen   diff_ppt
##         <int>        <dbl>     <dbl>      <dbl>
## 1           1    11658.071 11431.429 -1.9440853
## 2           2    12900.417 12629.972 -2.0964008
## 3           3    12793.886 12424.886 -2.8841902
## 4           4    12735.145 12310.132 -3.3373249
## 5           5    12545.100 11744.400 -6.3825717
## 6           6     8650.625  8592.583 -0.6709534
## 7           7     7634.500  7557.676 -1.0062784

Note that the calculated percentage point differences (diff_ppt) may not match the ones in the visualization in the FiveThirtyEight article. There are two reasons for this:

Holidays are excluded in the FiveThirtyEight but not in this analysis.
Two data files are provided by FiveThirtyEight, one for years 1994 to 2003 and another for years 2000 to 2014. The numbers of births for the overlapping years (2000 – 2003) are not exactly the same. This app uses the SSA data for these years, however it is unclear which data source FiveThirtyEight used for these years.

Let’s start by making a very simple highchart of these data using the hchart() function:

hchart(diff13, "scatter", x = day_of_week, y = diff_ppt)

This plot has some attractive features. For example, if you hover over the points you should be able to view the actual values of the plotted data. But, we need to do some customization to make the plot look like the one in the FiveThirtyEight article. We can achieve that using the highchart() function along with some customization functions. Note that we separate the layers with the pipe operator.

highchart() %>%
  hc_add_series(data = round(diff13$diff_ppt, 4), type = "column",
                name = "Difference, in ppt",
                color = "#F0A1EA", showInLegend = FALSE) %>%
  hc_yAxis(title = list(text = "Difference, in ppt"), allowDecimals = FALSE) %>%
  hc_xAxis(categories = c("Monday", "Tuesday", "Wednesday", "Thursday",
                          "Friday", "Saturday", "Sunday"),
           tickmarkPlacement = "on",
           opposite = TRUE) %>%
  hc_title(text = "The Friday the 13th effect",
           style = list(fontWeight = "bold")) %>%
  hc_subtitle(text = "Difference in the share of U.S. births on 13th of each month
              from the average of births on the 6th and the 20th,
              1994 - 2004") %>%
  hc_tooltip(valueDecimals = 4,
             pointFormat = "Day: {point.x} <br> Diff: {point.y}") %>%
  hc_credits(enabled = TRUE,
             text = "Sources: CDC/NCHS, SOCIAL SECURITY ADMINISTRATION",
             style = list(fontSize = "10px")) %>%
  hc_add_theme(hc_theme_538())

Once again, an attractive feature of this visualization is the hover tooltip. Themes also make it easy to change the look of the plot (in this case using hc_theme_538() gets us very close to the original visualization). Additionally, we are able to easily change labels (e.g., names of days) without having to make changes in the original data.

Example 2: US births on Friday the 13th, an interactive look

Since the highcharter package is powered by htmlwidlgets, it is also Shiny compatible! In order to build a highchart within a Shiny app, we use the renderHighchart() function.

We have built an app that extends the visualization we created earlier, allowing for custom selection of years plotted, type of plot, and theme. You can view the app and the source code here.

Things to Look Out For

Highcharts’ built-in and customizable hover/tooltip box and zooming functionality are among its most attractive features. However, whether or not these features would be useful for you depends on your use case.

For example, the tooltip is not as useful if you are plotting data with larger sample sizes. Take a look at this plot of arrival vs. departure delays of flights headed to Los Angeles (LAX) in October 2013 from the various New York airports. The overplotting on the lower left of the plot makes the hovering functionality not that useful.

library(nycflights13)
oct_lax_flights <- flights %>%
filter(month == 10, dest == "LAX")
hchart(oct_lax_flights, "scatter", x = dep_delay, y = arr_delay, group = origin)

However, if we aggregated the data a bit to reduce the number of points plotted, this functionality could once again come in handy. For example, below we group the flights by 15-minute intervals in departure delays, and plot the median arrival delay for these intervals.

oct_lax_flights_agg <- oct_lax_flights %>%
  mutate(dep_delay_cat = cut(dep_delay, breaks = seq(-15, 255, 15))) %>%
  group_by(origin, dep_delay_cat) %>%
  summarise(med_arr_delay = median(arr_delay, na.rm = TRUE))
hchart(oct_lax_flights_agg, "line", x = dep_delay_cat, y = med_arr_delay, group = origin)

Summary

Highcharts provides high quality web graphics with high customizability, and the highcharter package allows R users to take full advantage of them. If you’re interested in finding out more about the functionality of the package, I highly recommend browsing the highcharter package homepage which contains a variety of Highcharts, Highstock and Highmaps plots along with sample code to reproduce them. Additionally, the Highcharts Options Reference page is immensely useful for finding the specific syntax for customization options.