Highcharter on R Views

A Look Back on 2018: Part 2

Tue, 12 Feb 2019 00:00:00 +0000

Welcome to the second installment of Reproducible Finance 2019!

In the previous post, we looked back on the daily returns for several market sectors in 2018. Today, we’ll continue that theme and look at some summary statistics for 2018, and then extend out to previous years and different ways of visualizing our data. There’s not much heavy computation or even modeling today, but the goal is to lay some foundational code that we could use for different years or buckets of stocks, and to create some exploratory visualizations.

First, let’s load up our packages for the day.

library(tidyverse)
library(tidyquant)
library(riingo)
library(highcharter)

Next let’s grab our prices and returns for market sectors. We covered this in detail in the previous post and I won’t walk through it again, but here is the full code.

Note one change: last time, we imported data and calculated returns for just 2018. Today, I’ll set the start date to start_date = "2007-12-29" and import data for the 10 years from 2008 - 2018. That’s because, in addition to looking at summary statistics in just 2018, we will also look at some stats on a yearly basis from 2008 - 2018.

Here’s the code to import prices and calculate daily returns for our sector ETFs.

etf_ticker_sector <- tibble(
  ticker = c("XLY", "XLP", "XLE",   
          "XLF", "XLV", "XLI", "XLB", 
          "XLK", "XLU", "XLRE", 
          "SPY"),   
  sector = c("Consumer Discretionary", "Consumer Staples", "Energy", 
          "Financials", "Health Care", "Industrials", "Materials", 
          "Information Technology", "Utilities", "Real Estate",
          "Market")
)



#riingo_set_token("your API key here")

sector_returns_2008_2018 <- 
  etf_ticker_sector %>%
  pull(ticker) %>% 
  riingo_prices(., 
                start_date = "2007-12-29",
                end_date = "2018-12-31") %>%
  mutate(date = ymd(date)) %>%
  left_join(etf_ticker_sector, by = "ticker") %>%
  select(sector, date, adjClose) %>%
  group_by(sector) %>% 
  mutate(daily_return = log(adjClose) - log(lag(adjClose))) %>% 
  na.omit()

Let’s take a quick peek at the first observation for each sector by using slice(1), which will respect our group_by().

sector_returns_2008_2018 %>% 
  group_by(sector) %>% 
  slice(1)

# A tibble: 11 x 4
# Groups:   sector [11]
   sector                 date       adjClose daily_return
   <chr>                  <date>        <dbl>        <dbl>
 1 Consumer Discretionary 2008-01-02     27.3     -0.0154 
 2 Consumer Staples       2008-01-02     21.1     -0.0143 
 3 Energy                 2008-01-02     62.5      0.00189
 4 Financials             2008-01-02     18.6     -0.0199 
 5 Health Care            2008-01-02     28.8     -0.0105 
 6 Industrials            2008-01-02     30.4     -0.0167 
 7 Information Technology 2008-01-02     21.8     -0.0205 
 8 Market                 2008-01-02    115.      -0.00879
 9 Materials              2008-01-02     32.2     -0.00964
10 Real Estate            2015-10-09     26.7     -0.00166
11 Utilities              2008-01-02     27.8     -0.00569

This looks good, but I’d like to confirm that we successfully imported prices and calculated returns for each year and for each sector, meaning I want group_by(year, sector) and then slice(1). Problem is: there’s not currently a column called year.

We can fix that by separating the date column into year and month with the incredibly useful separate() function. We will run separate(date, c("year", "month"), sep = "-", remove = FALSE). I use remove = FALSE because I want to keep the date column.

It’s not necessary, but for ease of viewing in this post, I’ll peek at just sectors that contain the word “Consumer”, by calling filter(sector, str_detect("Consumer")).

sector_returns_2008_2018 %>%
  separate(date, c("year", "month"), sep = "-", remove = FALSE) %>% 
  group_by(year, sector) %>% 
  slice(1) %>% 
  filter(str_detect(sector, "Consumer"))

# A tibble: 22 x 6
# Groups:   year, sector [22]
   sector                 date       year  month adjClose daily_return
   <chr>                  <date>     <chr> <chr>    <dbl>        <dbl>
 1 Consumer Discretionary 2008-01-02 2008  01        27.3    -0.0154  
 2 Consumer Staples       2008-01-02 2008  01        21.1    -0.0143  
 3 Consumer Discretionary 2009-01-02 2009  01        19.5     0.0489  
 4 Consumer Staples       2009-01-02 2009  01        18.5     0.0141  
 5 Consumer Discretionary 2010-01-04 2010  01        26.3     0.00770 
 6 Consumer Staples       2010-01-04 2010  01        20.9     0.00753 
 7 Consumer Discretionary 2011-01-03 2011  01        33.7     0.0117  
 8 Consumer Staples       2011-01-03 2011  01        23.6     0.00136 
 9 Consumer Discretionary 2012-01-03 2012  01        35.6     0.00842 
10 Consumer Staples       2012-01-03 2012  01        26.9    -0.000924
# … with 12 more rows

OK, we’ve confirmed that we have prices and returns for our sectors for each year. Those new month and year columns will come in handy later, so let’s go ahead and save them.

sector_returns_2008_2018_year_mon <-
  sector_returns_2008_2018 %>%
  separate(date, c("year", "month"), sep = "-", remove = FALSE) %>% 
  group_by(year, sector)

We’re going to look back on several summary statistics for 2018 first: mean daily return, standard deviation, skewness, and kurtosis of daily returns. We will use the summarise() function and then filter(year == "2018") to get our stats for just 2018.

sector_returns_2008_2018_year_mon %>%
  summarise(avg = mean(daily_return),
            stddev = sd(daily_return),
            skew = skewness(daily_return),
            kurt = kurtosis(daily_return)) %>%
  filter(year == "2018")

# A tibble: 11 x 6
# Groups:   year [1]
   year  sector                        avg  stddev   skew  kurt
   <chr> <chr>                       <dbl>   <dbl>  <dbl> <dbl>
 1 2018  Consumer Discretionary  0.0000629 0.0122  -0.199 2.61 
 2 2018  Consumer Staples       -0.000335  0.00915 -0.664 1.54 
 3 2018  Energy                 -0.000801  0.0140  -0.294 1.58 
 4 2018  Financials             -0.000557  0.0124  -0.675 2.47 
 5 2018  Health Care             0.000243  0.0111  -0.604 2.31 
 6 2018  Industrials            -0.000566  0.0120  -0.717 2.08 
 7 2018  Information Technology -0.0000667 0.0147  -0.336 1.82 
 8 2018  Market                 -0.000186  0.0108  -0.479 3.18 
 9 2018  Materials              -0.000641  0.0121  -0.210 0.861
10 2018  Real Estate            -0.0000957 0.0103  -0.548 1.41 
11 2018  Utilities               0.000153  0.00956 -0.621 1.82

We can build off that code flow to select just the years 2014 and 2015 with filter(year %in% c("2014", "2015") and, say, the energy sector with str_detect(sector, "Energy").

sector_returns_2008_2018_year_mon %>%
  summarise(avg = mean(daily_return),
            stddev = sd(daily_return),
            skew = skewness(daily_return),
            kurt = kurtosis(daily_return)) %>%
  filter(year %in% c("2014", "2015") &
        str_detect(sector, "Energy"))

# A tibble: 2 x 6
# Groups:   year [2]
  year  sector       avg stddev    skew  kurt
  <chr> <chr>      <dbl>  <dbl>   <dbl> <dbl>
1 2014  Energy -0.000361 0.0117 -0.891  4.43 
2 2015  Energy -0.000959 0.0157  0.0157 0.813

Think about how that code flow might be useful in a Shiny application, where we let the end user choose a sector, a year, and possibly which summary stats to calculate and display.

Now let’s do some visualizing.

We’ll start with a column chart, where the height is equal to the sector skewness for the chosen year.

sector_returns_2008_2018_year_mon %>% 
  summarise(avg = mean(daily_return),
            stddev = sd(daily_return),
            skew = skewness(daily_return),
            kurt = kurtosis(daily_return)) %>%
 filter(year == "2018") %>% 
  ggplot(aes(x = sector, y = skew, fill = sector)) +
  geom_col(width = .3) +
  ylim(-1,1) +
  theme(axis.text.x = element_text(angle = 90, vjust = 1, hjust=1))

Here’s the same exact data, except we’ll use a scatter plot where the height of each point is the skewness.

sector_returns_2008_2018_year_mon %>% 
  summarise(avg = mean(daily_return),
            stddev = sd(daily_return),
            skew = skewness(daily_return),
            kurt = kurtosis(daily_return)) %>%
 filter(year == "2018") %>% 
  ggplot(aes(x = sector, y = skew, color = sector)) +
  geom_point(size = .8) +
  ylim(-1, 1) +
  theme(axis.text.x = element_text(angle = 90, vjust = 1, hjust=1))

For both of the charts above, we could change our filter(year == ...) to choose a different year and build a new chart, but instead let’s comment out the year filter altogether, meaning we will chart all years, and then call facet_wrap(~year).

sector_returns_2008_2018_year_mon %>% 
  summarise(avg = mean(daily_return),
            stddev = sd(daily_return),
            skew = skewness(daily_return),
            kurt = kurtosis(daily_return)) %>%
 # filter(year == "2018") %>% 
  ggplot(aes(x = sector, y = skew, fill = sector)) +
  geom_col(width = .5) +
  ylim(-1, 1) +
  theme(axis.text.x = element_text(angle = 90, vjust = 1, hjust=1)) +
  facet_wrap(~year)

This post was originally going to be focused on standard deviation, and not skewness, but there was recently an excellent piece on the Think New Found blog that discusses skewness and its importance as a risk measure. Definitely worth a read for the risk-return obsessed amongst us. For an R code reference, we covered skewness extensively in this previous blog post, and there’s bare code for the calculations on the Reproducible Finance site here.

Those ggplots are nice, but let’s take a quick look at how we might do this with highcharter.

sector_returns_2008_2018_year_mon %>% 
  summarise(avg = mean(daily_return),
            stddev = sd(daily_return),
            skew = skewness(daily_return),
            kurt = kurtosis(daily_return)) %>%
 filter(year == "2018") %>% 
 hchart(., 
       type = 'column', 
       hcaes(y = skew,
             x = sector,
             group = sector)) %>% 
  hc_title(text = "2018 Sector Skew") %>%
  hc_subtitle(text = "by sector") %>% 
  hc_xAxis(title = list(text = "")) %>%
  hc_tooltip(headerFormat = "",
             pointFormat = "skewness: {point.y: .4f}% <br>
                            mean return: {point.avg: .4f}") %>% 
  hc_yAxis(labels = list(format = "{value}%")) %>% 
  hc_add_theme(hc_theme_flat()) %>%
  hc_exporting(enabled = TRUE) %>% 
  hc_legend(enabled = FALSE)

Hover on the bars and notice that we included the mean return for each sector as well. That’s the beauty of highcharter: we can easily add more data in the tooltip using the hc_tooltip() function. Those skews look pretty daunting, but that’s down to the scale of the y-axis of this chart, which defaults to a max of 0 and a minimum of .8%. Let’s coerce it to max of 1 and a min of -1, which is a rough boundary for where we are comfortable with skewness.

sector_returns_2008_2018_year_mon %>% 
  summarise(avg = mean(daily_return),
            stddev = sd(daily_return),
            skew = skewness(daily_return),
            kurt = kurtosis(daily_return)) %>%
 filter(year == "2018") %>% 
 hchart(., 
       type = 'column', 
       hcaes(y = skew,
             x = sector,
             group = sector)) %>% 
  hc_title(text = "2018 Skew by Sector") %>%
  hc_xAxis(title = list(text = "")) %>%
  hc_tooltip(headerFormat = "",
             pointFormat = "skewness: {point.y: .4f}% <br>
                            mean return: {point.avg: .4f}") %>% 
  hc_yAxis(labels = list(format = "{value}%"),
           min = -1,
           max =1) %>% 
  hc_add_theme(hc_theme_flat()) %>%
  hc_exporting(enabled = TRUE) %>% 
  hc_legend(enabled = FALSE)

Let’s explore one more piece of data. After breaking up the date into year and month and looking at the daily returns and skewness, I got to wondering if the minimum daily return for each sector tended to fall in a certain month. There’s no reason it should, but it seems like a trend we might want to parse, or at least have thought about in case we need it.

My first instinct was to use summarise() and get the minimum daily return for each year-sector pair.

sector_returns_2008_2018_year_mon %>% 
  summarise(min_ret = min(daily_return)) %>% 
  head()

# A tibble: 6 x 3
# Groups:   year [1]
  year  sector                 min_ret
  <chr> <chr>                    <dbl>
1 2008  Consumer Discretionary -0.116 
2 2008  Consumer Staples       -0.0568
3 2008  Energy                 -0.160 
4 2008  Financials             -0.182 
5 2008  Health Care            -0.0687
6 2008  Industrials            -0.0947

The problem with that flow is that our month got deleted and we would like to preserve that for charting. We’re better off to filter() by the min(daily_return).

sector_returns_2008_2018_year_mon %>% 
  select(-adjClose, -date) %>% 
  filter(daily_return == min(daily_return)) %>%
  group_by(sector) %>% 
  filter(year == "2008") %>% 
  head()

# A tibble: 6 x 4
# Groups:   sector [6]
  sector                 year  month daily_return
  <chr>                  <chr> <chr>        <dbl>
1 Consumer Discretionary 2008  10         -0.116 
2 Consumer Staples       2008  12         -0.0568
3 Energy                 2008  10         -0.160 
4 Financials             2008  12         -0.182 
5 Health Care            2008  10         -0.0687
6 Industrials            2008  10         -0.0947

That’s giving us the same end data for the minimum daily return, but it’s also preserving the month column.

Let’s take a quick look to see if any months jump out as frequent holders of the minimum daily return. Note that we’ll need to ungroup() the data before running count(month).

sector_returns_2008_2018_year_mon %>% 
  filter(daily_return == min(daily_return)) %>%
  ungroup() %>% 
  count(month)

# A tibble: 11 x 2
   month     n
   <chr> <int>
 1 01        6
 2 02       18
 3 03        4
 4 04        4
 5 05       14
 6 06       22
 7 08       23
 8 09        3
 9 10        9
10 11        3
11 12        8

Hmmm, months 5, 6 and 8 jump out a bit. Let’s translate those to their actual names using mutate(month = month(date, label = TRUE, abbr = FALSE)).

sector_returns_2008_2018_year_mon %>% 
  filter(daily_return == min(daily_return)) %>%
  mutate(month = month(date, label = TRUE, abbr = FALSE)) %>% 
  ungroup() %>% 
  count(month)

# A tibble: 11 x 2
   month         n
   <ord>     <int>
 1 January       6
 2 February     18
 3 March         4
 4 April         4
 5 May          14
 6 June         22
 7 August       23
 8 September     3
 9 October       9
10 November      3
11 December      8

Visualizing these monthly tendencies was a bit more involved than I had anticipated, and that usually means I’ve missed a simpler solution somewhere, but I’ll post my brute force insanity in case it’s helpful to others.

I want to create a chart that looks like this, with months on the x-axis and the minimum daily return for each sector on the y-axis, almost as if we’re trying to see if the minimum daily returns tend to cluster in any months.

To create that chart, I want the names of the months on the x-axis, but also in the correct order. If we coerce the numbers to month names ahead of charting, ggplot will put them in alphabetical order, which is not what we want.

To solve that problem, I first created a vector of months.

months <- 
  sector_returns_2008_2018_year_mon %>% 
  mutate(months = month(date, label = TRUE, abbr = FALSE)) %>% 
  pull() %>%
  levels() %>% 
  as.character()

months

 [1] "January"   "February"  "March"     "April"     "May"      
 [6] "June"      "July"      "August"    "September" "October"  
[11] "November"  "December"

Next, comes our usual flow from the sector returns to ggplot, but first we coerce the month column with as.numeric() (when we used separate() before, it created a character column). Then we put month on the x-axis with ggplot(aes(x = month...)). To create the proper labels, we use scale_x_continuous( breaks = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), labels = months) to add 12 breaks and label them with our months vector that we created above.

  sector_returns_2008_2018_year_mon %>% 
  filter(daily_return == min(daily_return)) %>% 
  mutate(month = as.numeric(month)) %>% 
    ggplot(aes(x = month, y = daily_return, color = sector)) +
    geom_point() +
    scale_x_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), 
                       labels = months) + 
   labs(y = "min return", title = "2008 - 2018 Min Returns by Month") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1),
          plot.title = element_text(hjust = 0.5))

We can facet by sector if we want to break this into pieces.

  sector_returns_2008_2018_year_mon %>% 
  filter(daily_return == min(daily_return)) %>% 
  mutate(month = as.numeric(month)) %>% 
    ggplot(aes(x = month, y = daily_return, color = sector)) +
    geom_point() +
    scale_x_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), 
                       labels = months)  + 
   labs(y = "min return", title = "2008 - 2018 Min Returns by Month") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1),
          plot.title = element_text(hjust = 0.5)) +
  facet_wrap(~sector)

Or we can facet by year.

sector_returns_2008_2018_year_mon %>% 
  filter(daily_return == min(daily_return)) %>% 
  mutate(month = as.numeric(month)) %>% 
    ggplot(aes(x = month, y = daily_return, color = sector)) +
    geom_point() +
    scale_x_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), 
                       labels = months)  + 
   labs(y = "min return", title = "2008 - 2018 Min Returns by Month") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1),
          plot.title = element_text(hjust = 0.5)) +
  facet_wrap(~year)

Interesting to see that in 2011, each of our sectors had their minimum daily return in the same month.

That’s all for today. Thanks for reading and see you next time!

Highcharting Jobs Friday

Thu, 09 Aug 2018 00:00:00 +0000

Today, in honor of last week’s jobs report from the Bureau of Labor Statistics (BLS), we will visualize jobs data with ggplot2 and then, more extensively with highcharter. Our aim is to explore highcharter and its similarity with ggplot and to create some nice interactive visualizations. In the process, we will cover how to import BLS data from FRED and then wrangle it for visualization. We won’t do any modeling or statistical analysis today, though it wouldn’t be hard to extend this script into a forecasting exercise. One nice thing about today’s code flow is that it can be refreshed and updated on each BLS release date.

Let’s get to it!

We will source our data from FRED and will use the tq_get() function from tidyquant which enables us to import many data series at once in tidy, tibble format. We want to get total employment numbers, ADP estimates, and the sector-by-sector numbers that make up total employment. Let’s start by creating a tibble to hold the FRED codes and more intuitive names for each data series.

library(tidyverse)
library(tidyquant)

codes_names_tbl <- tribble(
        ~ symbol, ~ better_names,
        "NPPTTL", "ADP Estimate",
        "PAYEMS", "Nonfarm Employment",
        "USCONS", "Construction",
        "USTRADE",   "Retail/Trade",
        "USPBS",  "Prof/Bus Serv",
        "MANEMP",    "Manufact",
        "USFIRE",    "Financial",
        "USMINE",   "Mining",
        "USEHS",    "Health Care",
        "USWTRADE",    "Wholesale Trade",
        "USTPU",    "Transportation",
        "USINFO",    "Info Sys",
        "USLAH",    "Leisure",
        "USGOVT",    "Gov",
        "USSERV",    "Other Services"
)

Now we pass the symbol column to tq_get().

fred_empl_data <- 
  tq_get(codes_names_tbl$symbol,                         
         get = "economic.data",             
         from = "2007-01-01")

We have our data but look at the symbol column.

fred_empl_data %>% 
  group_by(symbol) %>% 
  slice(1)

# A tibble: 15 x 3
# Groups:   symbol [15]
   symbol   date         price
   <chr>    <date>       <dbl>
 1 MANEMP   2007-01-01  14008 
 2 NPPTTL   2007-01-01 115437.
 3 PAYEMS   2007-01-01 137497 
 4 USCONS   2007-01-01   7725 
 5 USEHS    2007-01-01  18415 
 6 USFIRE   2007-01-01   8389 
 7 USGOVT   2007-01-01  22095 
 8 USINFO   2007-01-01   3029 
 9 USLAH    2007-01-01  13338 
10 USMINE   2007-01-01    706 
11 USPBS    2007-01-01  17834 
12 USSERV   2007-01-01   5467 
13 USTPU    2007-01-01  26491 
14 USTRADE  2007-01-01  15443.
15 USWTRADE 2007-01-01   5969.

The symbols are the FRED codes, which are unrecognizable unless you have memorized how those codes map to more intuitive names. Let’s replace them with the better_names column of codes_names_tbl. We will do this with a left_join(). (This explains why I labeled our original column as symbol - it makes the left_join() easier.) Special thanks to Jenny Bryan for pointing out this code flow!

fred_empl_data %>% 
  left_join(codes_names_tbl, 
            by = "symbol" ) %>% 
  select(better_names, everything(), -symbol) %>% 
  group_by(better_names) %>% 
  slice(1)

# A tibble: 15 x 3
# Groups:   better_names [15]
   better_names       date         price
   <chr>              <date>       <dbl>
 1 ADP Estimate       2007-01-01 115437.
 2 Construction       2007-01-01   7725 
 3 Financial          2007-01-01   8389 
 4 Gov                2007-01-01  22095 
 5 Health Care        2007-01-01  18415 
 6 Info Sys           2007-01-01   3029 
 7 Leisure            2007-01-01  13338 
 8 Manufact           2007-01-01  14008 
 9 Mining             2007-01-01    706 
10 Nonfarm Employment 2007-01-01 137497 
11 Other Services     2007-01-01   5467 
12 Prof/Bus Serv      2007-01-01  17834 
13 Retail/Trade       2007-01-01  15443.
14 Transportation     2007-01-01  26491 
15 Wholesale Trade    2007-01-01   5969.

That looks much better, but we now have a column called price, that holds the monthly employment observations, and a column called better_names, that holds the more intuitive group names. Let’s change those column names to employees and sector.

fred_empl_data <- 
fred_empl_data %>% 
  left_join(codes_names_tbl, 
            by = "symbol" ) %>% 
  select(better_names, everything(), -symbol) %>% 
  rename(employees = price, sector = better_names)

head(fred_empl_data)

# A tibble: 6 x 3
  sector       date       employees
  <chr>        <date>         <dbl>
1 ADP Estimate 2007-01-01   115437.
2 ADP Estimate 2007-02-01   115527.
3 ADP Estimate 2007-03-01   115647 
4 ADP Estimate 2007-04-01   115754.
5 ADP Estimate 2007-05-01   115809.
6 ADP Estimate 2007-06-01   115831.

fred_empl_data has the names and organization we want, but it still has the raw number of employees per month. We want to visualize the month-to-month change in jobs numbers, which means we need to perform a calculation on our data and store it in a new column. We use mutate() to create the new column and calculate monthly change with value - lag(value, 1). We are not doing any annualizing or seasonality work here - it’s a simple substraction. For yearly change, it would be value - lag(value, 12).

empl_monthly_change <- 
  fred_empl_data  %>% 
  group_by(sector) %>% 
  mutate(monthly_change = employees - lag(employees, 1)) %>% 
  na.omit()

Our final data object empl_monthly_change is tidy, has intuitive names in the group column, and has the monthly change that we wish to visualize. Let’s build some charts.

We will start at the top and use ggplot to visualize how total non-farm employment (Sorry farmers. Your jobs don’t count, I guess) has changed since 2007. We want an end-user to quickly glance at the chart and find the months with positive jobs growth and negative jobs growth. That means we want months with positive jobs growth to be one color, and those with negative jobs growth to be another color. There is more than one way to accomplish this, but I like to create new columns and then add geoms based on those columns. (Check out this post by Freddie Mac’s Len Kiefer for another way to accomplish this by nesting ifelse statements in ggplot's aesthetics. In fact, if you like data visualization, check out all the stuff that Len writes.)

Let’s walk through how to create columns for shading by positive or negative jobs growth. First, we are looking at total employment here, so we call filter(sector == "Nonfarm Employment") to get only total employment.

Next, we create two new columns with mutate(). The first is called col_pos and is formed by if_else(monthly_change > 0, monthly_change,...). That logic is creating a column that holds the value of monthly change if monthly change is positive, else it holds NA. We then create another column called col_neg using the same logic.

empl_monthly_change %>% 
  filter(sector == "Nonfarm Employment") %>% 
   mutate(col_pos = 
           if_else(monthly_change > 0, 
                  monthly_change, as.numeric(NA)),
         col_neg = 
           if_else(monthly_change < 0, 
                  monthly_change, as.numeric(NA))) %>% 
  dplyr::select(sector, date, col_pos, col_neg) %>% 
  head()

# A tibble: 6 x 4
# Groups:   sector [1]
  sector             date       col_pos col_neg
  <chr>              <date>       <dbl>   <dbl>
1 Nonfarm Employment 2007-02-01      85      NA
2 Nonfarm Employment 2007-03-01     214      NA
3 Nonfarm Employment 2007-04-01      59      NA
4 Nonfarm Employment 2007-05-01     153      NA
5 Nonfarm Employment 2007-06-01      77      NA
6 Nonfarm Employment 2007-07-01      NA     -30

Have a qucik look at the col_pos and col_neg columns and make sure they look right. col_pos should have only positive and NA values, col_neg shoud have only negative and NA values.

Now we can visualize our monthly changes with ggplot, adding a separate geom for those new columns.

empl_monthly_change %>% 
  filter(sector == "Nonfarm Employment") %>% 
   mutate(col_pos = 
           if_else(monthly_change > 0, 
                  monthly_change, as.numeric(NA)),
         col_neg = 
           if_else(monthly_change < 0, 
                  monthly_change, as.numeric(NA))) %>%
  ggplot(aes(x = date)) +
  geom_col(aes(y = col_neg),
               alpha = .85,
               fill = "pink",
               color = "pink") +
  geom_col(aes(y = col_pos),
               alpha = .85,
               fill = "lightgreen",
               color = "lightgreen") +
  ylab("Monthly Change (thousands)") +
  labs(title = "Monthly Private Employment Change",
       subtitle = "total empl, since 2008",
       caption = "inspired by @lenkiefer") +
  scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1),
        plot.title = element_text(hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5),
        plot.caption = element_text(hjust=0))

That plot is nice, but it’s static! Hover on it and you’ll see what I mean.

Let’s head to highcharter and create an interactive chart that responds when we hover on it. By way of brief background, highcharter is an R hook into the fantastic highcharts JavaScript library. It’s free for personal use but a license is required for commercial use.

One nice feature of highcharter is that we can use very similar aesthetic logic to what we used for ggplot. It’s not identical, but it’s similar and let’s us work with tidy data.

Before we get to the highcharter logic, we will add one column to our tibble to hold the color scheme for our positive and negative monthly changes. Notice how this is different from the ggplot flow above where we create one column to hold our positive changes for coloring and one column to hold our negative changes for coloring.

I want to color positive changes light blue and negative changes pink, and put the rgb codes for those colors directly in the new column. The rgb code for light blue is “#6495ed” and for pink is “#ffe6ea”. Thus we use ifelse to create a column called color_of_bars that holds “#6495ed” (light blue) when monthly_change is postive and “#ffe6ea” (pink) when it’s negative.

total_employ_hc <- 
  empl_monthly_change %>% 
  filter(sector == "Nonfarm Employment") %>% 
  mutate(color_of_bars = ifelse(monthly_change > 0, "#6495ed", "#ffe6ea"))

head(total_employ_hc)

# A tibble: 6 x 5
# Groups:   sector [1]
  sector             date       employees monthly_change color_of_bars
  <chr>              <date>         <dbl>          <dbl> <chr>        
1 Nonfarm Employment 2007-02-01    137582             85 #6495ed      
2 Nonfarm Employment 2007-03-01    137796            214 #6495ed      
3 Nonfarm Employment 2007-04-01    137855             59 #6495ed      
4 Nonfarm Employment 2007-05-01    138008            153 #6495ed      
5 Nonfarm Employment 2007-06-01    138085             77 #6495ed      
6 Nonfarm Employment 2007-07-01    138055            -30 #ffe6ea

Now we are ready to start the highcharter flow.

We start by calling hchart to pass in our data object. Note the similarity to ggplot where we started with ggplot.

Now, intead of waiting for a call to geom_col, we set type = "column" to let hchart know that we are building a column chart. Next, we use hcaes(x = date, y = monthly_change, color = color_of_bars) to specify our aesthetics. Notice how we can control the colors of the bars from values in the color_of_bars column.

We also supply a name = "monthly change" because we want monthly change to appear when a user hovers on the chart. That wasn’t a consideration with ggplot.

library(highcharter)
hchart(total_employ_hc,  
                type = "column", 
                pointWidth = 5,
                hcaes(x = date,
                      y = monthly_change,
                      color = color_of_bars),
                name = "monthly change") %>%
  hc_title(text = "Monthly Employment Change") %>%
  hc_xAxis(type = "datetime") %>%
  hc_yAxis(title = list(text = "monthly change (thousands)")) %>%
  hc_exporting(enabled = TRUE)

Let’s stay in the highcharter world and visualize how each sector changed in the most recent month, which is July of 2018.

First, we isolate the most recent month by filtering on the last date. We also don’t want the ADP Estimate and filter that out as well.

empl_monthly_change %>% 
filter(date == (last(date))) %>%
filter(sector != "ADP Estimate")

# A tibble: 14 x 4
# Groups:   sector [14]
   sector             date       employees monthly_change
   <chr>              <date>         <dbl>          <dbl>
 1 Nonfarm Employment 2018-07-01   149128           157  
 2 Construction       2018-07-01     7242            19  
 3 Retail/Trade       2018-07-01    15944             7.1
 4 Prof/Bus Serv      2018-07-01    21019            51  
 5 Manufact           2018-07-01    12751            37  
 6 Financial          2018-07-01     8568            -5  
 7 Mining             2018-07-01      735            -4  
 8 Health Care        2018-07-01    23662            22  
 9 Wholesale Trade    2018-07-01     5982.           12.3
10 Transportation     2018-07-01    27801            15  
11 Info Sys           2018-07-01     2772             0  
12 Leisure            2018-07-01    16371            40  
13 Gov                2018-07-01    22334           -13  
14 Other Services     2018-07-01     5873            -5

That filtered flow has the data we want, but we have two more tasks. First, we want to arrange this data so that it goes from smallest to largest. If we did not do this, our chart would still “work”, but the column heights would not progress from lowest to highest.

Second, we need to create another column to hold colors for negative and positive values, with the same ifelse() logic as we used before.

emp_by_sector_recent_month <- 
  empl_monthly_change  %>% 
  filter(date == (last(date))) %>%
  filter(sector != "ADP Estimate") %>% 
  arrange(monthly_change) %>% 
  mutate(color_of_bars = if_else(monthly_change > 0, "#6495ed", "#ffe6ea"))

Now we pass that object to hchart, set type = "column", and choose our hcaes values. We want to label the x-axis with the different sectors and do that with hc_xAxis(categories = emp_by_sector_recent_month$sector).

last_month <- lubridate::month(last(empl_monthly_change$date),
                                 label = TRUE, 
                                 abbr = FALSE)

hchart(emp_by_sector_recent_month,  
                type = "column", 
                pointWidth = 20,
                hcaes(x = sector,
                      y = monthly_change,
                      color = color_of_bars),
                showInLegend = FALSE) %>% 
  hc_title(text = paste(last_month, "Employment Change", sep = " ")) %>%
  hc_xAxis(categories = emp_by_sector_recent_month$sector) %>%
  hc_yAxis(title = list(text = "Monthly Change (thousands)"))

Finally, let’s compare the ADP Estimates to the actual Nonfarm payroll numbers since 2017. We start with filtering again.

adp_bls_hc <- 
  empl_monthly_change %>% 
  filter(sector == "ADP Estimate" | sector == "Nonfarm Employment") %>% 
  filter(date >= "2017-01-01")

We create a column to hold different colors, but our logic is not whether a reading is positive or negative. We want to color the ADP and BLS reports differently.

adp_bls_hc <- 
  adp_bls_hc %>% 
  mutate(color_of_bars = 
           ifelse(sector == "ADP Estimate", "#ffb3b3", "#4d94ff"))

head(adp_bls_hc)

# A tibble: 6 x 5
# Groups:   sector [1]
  sector       date       employees monthly_change color_of_bars
  <chr>        <date>         <dbl>          <dbl> <chr>        
1 ADP Estimate 2017-01-01   123253.           245. #ffb3b3      
2 ADP Estimate 2017-02-01   123533.           280. #ffb3b3      
3 ADP Estimate 2017-03-01   123655            122. #ffb3b3      
4 ADP Estimate 2017-04-01   123810.           155. #ffb3b3      
5 ADP Estimate 2017-05-01   124012.           202. #ffb3b3      
6 ADP Estimate 2017-06-01   124166.           154. #ffb3b3

tail(adp_bls_hc)

# A tibble: 6 x 5
# Groups:   sector [1]
  sector             date       employees monthly_change color_of_bars
  <chr>              <date>         <dbl>          <dbl> <chr>        
1 Nonfarm Employment 2018-02-01    148125            324 #4d94ff      
2 Nonfarm Employment 2018-03-01    148280            155 #4d94ff      
3 Nonfarm Employment 2018-04-01    148455            175 #4d94ff      
4 Nonfarm Employment 2018-05-01    148723            268 #4d94ff      
5 Nonfarm Employment 2018-06-01    148971            248 #4d94ff      
6 Nonfarm Employment 2018-07-01    149128            157 #4d94ff

And now we pass that object to our familiar hchart flow.

hchart(adp_bls_hc, 
       type = 'column', 
       hcaes(y = monthly_change,
             x = date,
             group = sector, 
             color = color_of_bars),
       showInLegend = FALSE
       ) %>% 
  hc_title(text = "ADP v. BLS") %>%
  hc_xAxis(type = "datetime") %>%
  hc_yAxis(title = list(text = "monthly change (thousands)")) %>%
  hc_add_theme(hc_theme_flat()) %>%
  hc_exporting(enabled = TRUE)

That’s all for today. Try revisiting this script on September 7th, when the next BLS jobs data is released, and see if any new visualizations or code flows come to mind.

See you next time and happy coding!

Introduction to Visualizing Asset Returns

Thu, 09 Nov 2017 00:00:00 +0000

In a previous post, we reviewed how to import daily prices, build a portfolio, and calculate portfolio returns. Today, we will visualize the returns of our individual assets that ultimately get mashed into a portfolio. The motivation here is to make sure we have scrutinized our assets before they get into our portfolio, because once the portfolio has been constructed, it is tempting to keep the analysis at the portfolio level.

By way of a quick reminder, our ultimate portfolio consists of the following.

+ SPY (S&P 500 fund) weighted 25%
+ EFA (a non-US equities fund) weighted 25%
+ IJS (a small-cap value fund) weighted 20%
+ EEM (an emerging-mkts fund) weighted 20%
+ AGG (a bond fund) weighted 10%

Let’s load up our packages.

library(tidyverse)
library(tidyquant)
library(timetk)
library(tibbletime)
library(highcharter)

To get our objects into the global environment, we use the next code chunk, which should look familiar from the previous post: we will create one xts object and one tibble, in long/tidy format, of monthly log returns.

# The symbols vector holds our tickers. 
symbols <- c("SPY","EFA", "IJS", "EEM","AGG")

prices <- 
  getSymbols(symbols, src = 'yahoo', from = "2005-01-01", 
             auto.assign = TRUE, warnings = FALSE) %>% 
  map(~Ad(get(.))) %>% 
  reduce(merge) %>%
  `colnames<-`(symbols)

# XTS method
prices_monthly <- to.monthly(prices, indexAt = "last", OHLC = FALSE)
asset_returns_xts <- na.omit(Return.calculate(prices_monthly, method = "log"))

# Tidyverse method, to long, tidy format
asset_returns_long <- 
  prices %>% 
  to.monthly(indexAt = "last", OHLC = FALSE) %>% 
  tk_tbl(preserve_index = TRUE, rename_index = "date") %>%
  gather(asset, returns, -date) %>% 
  group_by(asset) %>%  
  mutate(returns = (log(returns) - log(lag(returns))))

We now have two objects holding monthly log returns, asset_returns_xts and asset_returns_long. First, let’s use highcharter to visualize the xts formatted returns.

Highcharter is fantastic for visualizing a time series or many time series. First, we set highchart(type = "stock") to get a nice time series line. Then we add each of our series to the highcharter code flow. In this case, we’ll add our columns from the xts object.

highchart(type = "stock") %>% 
  hc_title(text = "Monthly Log Returns") %>%
  hc_add_series(asset_returns_xts$SPY, 
                  name = names(asset_returns_xts$SPY)) %>%
  hc_add_series(asset_returns_xts$EFA, 
                  name = names(asset_returns_xts$EFA)) %>%
  hc_add_series(asset_returns_xts$IJS, 
                  name = names(asset_returns_xts$IJS)) %>%
  hc_add_theme(hc_theme_flat()) %>%
  hc_navigator(enabled = FALSE) %>% 
  hc_scrollbar(enabled = FALSE)

<<<<<<< HEAD

Take a look at the chart. It has a line for the monthly log returns of 3 of our ETFs (and in my opinion it’s already starting to get crowded). We might be able to pull some useful intuition from this chart. Perhaps one of our ETFs remained stable during the 2008 financial crisis, or had an era of consistently negative/positive returns. Highcharter is great for plotting time series line charts.

Highcharter does have the capacity for histogram making. One method is to first call the base function hist on the data along with the arguments for breaks and plot = FALSE. Then we can call hchart on that object.

=======

Take a look at the chart. It has a line for the monthly log returns of three of our ETFs (and in my opinion, it’s already starting to get crowded). We might be able to pull some useful intuition from this chart. Perhaps one of our ETFs remained stable during the 2008 financial crisis, or had an era of consistently negative/positive returns. Highcharter is great for plotting time series line charts.

Highcharter does have the capacity for histogram making. One method is to first call the base function hist on the data with the arguments for breaks and plot = FALSE. Then we can call hchart on that object.

>>>>>>> ea33b5686b615c7a2697ce0b8da92b85932d655f

hc_spy <- hist(asset_returns_xts$SPY, breaks = 50, plot = FALSE)

hchart(hc_spy) %>% 
  hc_title(text = "SPY Log Returns Distribution")

Nothing wrong with that chart, and it shows us the distribution of SPY returns. However, highcharter is missing an easy way to chart multiple histograms, and to add density lines to those multiple histograms. The functionality is fine for one set of returns, but here we want to see the distribution of all of our returns series together.

For that, we will head to the tidyverse and use ggplot2 on our tidy tibble called assets_returns_long. Because it is in long, tidy format, and it is grouped by the ‘asset’ column, we can chart the asset histograms collectively on one chart.

# Make so all titles centered in the upcoming ggplots
theme_update(plot.title = element_text(hjust = 0.5))

asset_returns_long %>% 
  ggplot(aes(x = returns, fill = asset)) + 
  geom_histogram(alpha = 0.25, binwidth = .01)

Let’s use facet_wrap(~asset) to break these out by asset. We can add a title with ggtitle.

asset_returns_long %>% 
  ggplot(aes(x = returns, fill = asset)) + 
  geom_histogram(alpha = 0.25, binwidth = .01) + 
  facet_wrap(~asset) + 
  ggtitle("Monthly Returns Since 2005")

Maybe we don’t want to use a histogram, but instead want to use a density line to visualize the various distributions. We can use the stat_density(geom = "line", alpha = 1) function to do this. The alpha argument is selecting a line thickness. Let’s also add a label to the x and y axes with the xlab and ylab functions.

asset_returns_long %>% 
  ggplot(aes(x = returns, colour = asset, fill = asset)) +
  stat_density(geom = "line", alpha = 1) +
  ggtitle("Monthly Returns Since 2005") +
  xlab("monthly returns") +
  ylab("distribution")

That chart is quite digestible, but we can also facet_wrap(~asset) to break the densities out into individual charts.

asset_returns_long %>% 
  ggplot(aes(x = returns, colour = asset, fill = asset)) +
  stat_density(geom = "line", alpha = 1) +
  facet_wrap(~asset) +
  ggtitle("Monthly Returns Since 2005") +
  xlab("monthly returns") +
  ylab("distribution")

Now we can combine all of our ggplots into one nice, faceted plot.

At the same time, to add to the aesthetic toolkit a bit, we will do some editing to the label colors. First off, let’s choose a different color besides black to be the theme. I will go with cornflower blue, because it’s a nice shade and I don’t see it used very frequently elsewhere. Once we have a color, we can choose the different elements of the chart to change in the the theme function. I make a lot of changes here by way of example but feel free to comment out a few of those lines and see the different options.

asset_returns_long %>% 
  ggplot(aes(x = returns, colour = asset, fill = asset)) +
  stat_density(geom = "line", alpha = 1) +
  geom_histogram(alpha = 0.25, binwidth = .01) +
  facet_wrap(~asset) +
  ggtitle("Monthly Returns Since 2005") +
  xlab("monthly returns") +
  ylab("distribution") +
  # Lots of elements can be customized in the theme() function
  theme(plot.title = element_text(colour = "cornflowerblue"),  
        strip.text.x = element_text(size = 8, colour = "white"), 
        strip.background = element_rect(colour = "white", fill = "cornflowerblue"), 
        axis.text.x = element_text(colour = "cornflowerblue"), 
        axis.text = element_text(colour = "cornflowerblue"), 
        axis.ticks.x = element_line(colour = "cornflowerblue"), 
        axis.text.y = element_text(colour = "cornflowerblue"), 
        axis.ticks.y = element_line(colour = "cornflowerblue"),
        axis.title = element_text(colour = "cornflowerblue"),
        legend.title = element_text(colour = "cornflowerblue"),
        legend.text = element_text(colour = "cornflowerblue")
        )

We now have one chart, with histograms and line densities broken out for each of our assets. This would scale nicely if we had more assets and wanted to peek at more distributions of returns.

We have not done any substantive work today, but the chart of monthly returns is a tool to quickly glance at the data and see if anything unusual jumps out, or some sort of hypothesis comes to mind. We are going to be combining these assets into a portfolio and, once that occurs, we will rarely view the assets in isolation again. Before that leap to portfolio building, it’s a good idea to glance at the portfolio component distributions.

That’s all for today. Thanks for reading!

Visualizing Portfolio Volatility

Fri, 21 Jul 2017 00:00:00 +0000

This is the third post in our series on portfolio volatility, variance and standard deviation. If you want to start at the beginning with calculating portfolio volatility, have a look at the first post here - Intro to Volatility. The second post on calculating rolling standard deviations is here: Intro to Rolling Volatility.

Today we will visualize rolling standard deviations with highcharter using two objects from that second post.

The charts, which are the fun payoff after all of the equations and functions that we have ground out in the previous posts, should highlight any unusual occurrences or volatility spikes/dips that we might want to investigate.

First, load the .RDat file saved from our previous Notebook (or you can run the scripts from the previous posts).

load('rolling-sd.RDat')

We now have 2 objects in our Global Environment - spy_rolling_sd - an xts object of rolling SPY standard deviations - roll_portfolio_result - an xts object of rolling portfolio standard deviations. Because both of those are xts objects, we can pass them straight to highcharter with the hc_add_series() function and set a name and a color with the name and color arguments. Nothing too complicated here - we did the hard work in our previous Notebooks.

highchart(type = "stock") %>%
  hc_title(text = "SPY v. Portfolio Rolling Volatility") %>%
  hc_add_series(spy_rolling_sd, name = "SPY Volatility", color = "blue") %>%
  hc_add_series(roll_portfolio_result, name = "Port Volatility", color = "green") %>%
  hc_navigator(enabled = FALSE) %>% 
  hc_scrollbar(enabled = FALSE)

It is interesting to note that from late April 2016 to late October 2016, SPY’s rolling standard deviation dipped below that of the diversified portfolio. The portfolio volatility was plunging at the same time, but SPY’s was falling faster. What happened over the 6 preceding months to explain this?

Maybe we should add a flag to highlight this event. We can also add flags for the maximum SPY volatility, maximum and minimum portfolio rolling volatility and might as well include a line for the mean rolling volatility of SPY to practice adding horizontal lines.

We will use two methods for adding flags. First, we’ll hard code the date for the flag as “2016-04-29” using the date when rolling SPY volatility dipped below the portfolio. Second, we’ll set a flag with the date
as.Date(index(roll_portfolio_result[which.max(roll_portfolio_result)]),format = "%Y-%m-%d") which looks like a convoluted mess but is adding a date for whenever the rolling portfolio standard deviation hit its maximum.

This is a bit more ‘dynamic’ because we can change our assets but keep this code the same and it will find the date with the maximum rolling standard deviation. Our first flag is not dynamic in the sense that it is specific to the comparison between SPY and this exact portfolio.

spy_important_date <- as.Date(c("2016-04-29"), format = "%Y-%m-%d")

port_max_date <- as.Date(index(roll_portfolio_result[which.max(roll_portfolio_result)]),
                         format = "%Y-%m-%d")
port_min_date <- as.Date(index(roll_portfolio_result[which.min(roll_portfolio_result)]),
                         format = "%Y-%m-%d")
spy_max_date <- as.Date(index(spy_rolling_sd[which.max(spy_rolling_sd)]),
                         format = "%Y-%m-%d")


highchart(type = "stock") %>%
  hc_title(text = "SPY v. Portfolio Rolling Volatility") %>%
  hc_add_series(spy_rolling_sd, name = "SPY Volatility", color = "blue", id = "SPY") %>%
  hc_add_series(roll_portfolio_result, name = "Portf Volatility", color = "green", id = "Port") %>%
  hc_add_series_flags(spy_important_date,
                      title = c("SPY Vol Dips"), 
                      text = c("SPY rolling sd dips below portfolio."),
                      id = "SPY") %>%
  hc_add_series_flags(spy_max_date,
                      title = c("SPY Max "), 
                      text = c("SPY max rolling volatility."),
                      id = "SPY") %>%
   hc_add_series_flags(port_max_date,
                      title = c("Portf Max"), 
                      text = c("Portfolio maximum rolling volatility."),
                      id = "Port") %>%
  hc_add_series_flags(port_min_date,
                      title = c("Portf Min"), 
                      text = c("Portfolio min rolling volatility."),
                      id = "Port") %>%
  hc_yAxis(title = list(text = "Mean SPY rolling Vol"),
           showFirstLabel = FALSE,
           showLastLabel = FALSE,
           plotLines = list(
             list(value = mean(spy_rolling_sd), color = "#2b908f", width = 2)))  %>% 
  hc_navigator(enabled = FALSE) %>% 
  hc_scrollbar(enabled = FALSE)

Hover on the flags and you can see the text we added for explanation.

It’s remarkable how rolling volatility has absolutely plunged since early-to-mid 2016. Since August of 2016, both the portfolio and SPY rolling standard deviations have been well below the SPY mean.

Thanks for sticking with this three-part introduction to volatility. Next time, we’ll port our work to Shiny and play with different assets and allocations.