# Load packages

# Core
library(tidyverse)
library(tidyquant)
library(readr)

# Time series
library(lubridate)
library(tibbletime)

# modeling
library(broom)

Goal

Examine how each asset contributes to portfolio standard deviation. This is to ensure that our risk is not concentrated in any one asset.

five stocks: “NVDA”, “WMT”, “GOOG”, “AAPL”, “AMZN” from 2012-12-31 to 2017-12-31

1 Import stock prices

symbols <- c("NVDA", "WMT", "GOOG", "AAPL", "AMZN")

prices <- tq_get(x    = symbols,
                 get  = "stock.prices",    
                 from = "2012-12-31",
                 to   = "2017-12-31")

2 Convert prices to returns

asset_returns_tbl <- prices %>%
    
    group_by(symbol) %>%
    
    tq_transmute(select     = adjusted, 
                 mutate_fun = periodReturn, 
                 period     = "monthly",
                 type       = "log") %>%
    
    slice(-1) %>%
    
    ungroup() %>%
    
    set_names(c("asset", "date", "returns"))

3 Component Contribution Step-by-Step

Refresh your memory on covariance with this video. Click this link Refresh your memory on matrix multiplication. Click this link

# Transform data into wide form
asset_returns_wide_tbl <- asset_returns_tbl %>%

    pivot_wider(names_from = asset, values_from = returns) %>%

    column_to_rownames(var = "date")

asset_returns_wide_tbl
##                     AAPL          AMZN         GOOG         NVDA           WMT
## 2013-01-31 -1.555893e-01  0.0566799395  0.066063281  0.000000000  0.0248966054
## 2013-02-28 -2.561117e-02 -0.0046435024  0.058479271  0.038221716  0.0117958390
## 2013-03-28  2.850827e-03  0.0083654162 -0.008787858  0.013339005  0.0620729264
## 2013-04-30  2.710907e-04 -0.0487507497  0.037539273  0.070706269  0.0378940266
## 2013-05-31  2.217159e-02  0.0588686246  0.055032566  0.054652110 -0.0317803265
## 2013-06-28 -1.258957e-01  0.0310507506  0.010447752 -0.030167503 -0.0046873959
## 2013-07-31  1.321022e-01  0.0813355350  0.008347993  0.028092115  0.0452742160
## 2013-08-30  8.044329e-02 -0.0695574090 -0.047107535  0.026269923 -0.0597001711
## 2013-09-30 -2.172386e-02  0.1067688897  0.033680612  0.053460722  0.0133389689
## 2013-10-31  9.201510e-02  0.1521839116  0.162613638 -0.024066457  0.0370290759
## 2013-11-29  6.770821e-02  0.0781496860  0.027760350  0.032034617  0.0540193838
## 2013-12-31  8.862220e-03  0.0130490386  0.056080312  0.026567336 -0.0232524264
## 2014-01-31 -1.139489e-01 -0.1059765119  0.052373784 -0.020177172 -0.0523035165
## 2014-02-28  5.591788e-02  0.0094619003  0.028942761  0.162107344  0.0002676061
## 2014-03-31  1.975653e-02 -0.0737086161 -0.086376159 -0.025903932  0.0293264460
## 2014-04-30  9.476136e-02 -0.1007565303 -0.055956105  0.030788285  0.0420197869
## 2014-05-30  7.576480e-02  0.0273091844  0.061185157  0.032886808 -0.0314095236
## 2014-06-30  2.728647e-02  0.0383836202  0.027116513 -0.024508474 -0.0223930164
## 2014-07-31  2.832633e-02 -0.0369768154 -0.006417501 -0.057729618 -0.0200474332
## 2014-08-29  7.465177e-02  0.0799468404  0.000000000  0.110060026  0.0323258096
## 2014-09-30 -1.722070e-02 -0.0502010184  0.010026606 -0.052782891  0.0127660991
## 2014-10-31  6.948916e-02 -0.0540982347 -0.032173406  0.057399343 -0.0026190558
## 2014-11-28  1.007305e-01  0.1031187277 -0.031340260  0.074852449  0.1378158923
## 2014-12-31 -7.460598e-02 -0.0872368614 -0.028890843 -0.044863523 -0.0135734377
## 2015-01-30  5.961124e-02  0.1330922557  0.015307816 -0.043319269 -0.0105351941
## 2015-02-27  9.601639e-02  0.0697992426  0.043706206  0.142698816 -0.0124327229
## 2015-03-31 -3.187428e-02 -0.0214295755 -0.018800098 -0.052582501 -0.0142313541
## 2015-04-30  5.769565e-03  0.1253212736 -0.016902574  0.058909007 -0.0524138434
## 2015-05-29  4.434124e-02  0.0175090293 -0.009780772  0.001459955 -0.0433512060
## 2015-06-30 -3.793817e-02  0.0112589814 -0.022041189 -0.095717312 -0.0460134457
## 2015-07-31 -3.348098e-02  0.2111621090  0.183918039 -0.007987637  0.0146946898
## 2015-08-31 -6.848903e-02 -0.0443525782 -0.011834290  0.123595493 -0.0993581413
## 2015-09-30 -2.205761e-02 -0.0019516837 -0.016027341  0.092150886  0.0016974200
## 2015-10-30  8.011225e-02  0.2010808743  0.155539701  0.140555264 -0.1246693277
## 2015-11-30 -5.821063e-03  0.0602956777  0.043752288  0.115405032  0.0275686100
## 2015-12-31 -1.167903e-01  0.0165440008  0.021686031  0.038347287  0.0492994217
## 2016-01-29 -7.822370e-02 -0.1410054620 -0.021214963 -0.118048485  0.0793144944
## 2016-02-29 -1.288001e-03 -0.0605352209 -0.062738961  0.071923802 -0.0003014207
## 2016-03-31  1.197458e-01  0.0717834363  0.065427602  0.127654975  0.0392707457
## 2016-04-29 -1.507310e-01  0.1053453760 -0.072272683 -0.002810751 -0.0239374976
## 2016-05-31  6.931437e-02  0.0915002899  0.059805109  0.276388222  0.0641209002
## 2016-06-30 -4.359685e-02 -0.0099694639 -0.061119364  0.006187810  0.0311569181
## 2016-07-29  8.623554e-02  0.0586021229  0.105087599  0.194444225 -0.0006849210
## 2016-08-31  2.337668e-02  0.0135476418 -0.002265810  0.073468891 -0.0143681218
## 2016-09-30  6.344805e-02  0.0848953908  0.013261375  0.110693488  0.0094733759
## 2016-10-31  4.325108e-03 -0.0583893058  0.009284212  0.037805245 -0.0295504517
## 2016-11-30 -2.183768e-02 -0.0509721927 -0.034361399  0.260525237  0.0058384120
## 2016-12-30  4.684076e-02 -0.0009330556  0.018015145  0.146435686 -0.0116435843
## 2017-01-31  4.664158e-02  0.0936394059  0.031839763  0.022602289 -0.0350394598
## 2017-02-28  1.255553e-01  0.0258446800  0.032620123 -0.071875304  0.0608889485
## 2017-03-31  4.754105e-02  0.0479423007  0.007684198  0.070843935  0.0234089591
## 2017-04-28 -6.917265e-05  0.0424566944  0.088099720 -0.043434233  0.0421084622
## 2017-05-31  6.560736e-02  0.0725778018  0.062987783  0.326022441  0.0511561239
## 2017-06-30 -5.891603e-02 -0.0271286156 -0.059935017  0.001453468 -0.0378573778
## 2017-07-31  3.218057e-02  0.0202278808  0.023674194  0.117045129  0.0553876702
## 2017-08-31  1.016530e-01 -0.0072953953  0.009444701  0.042639304 -0.0180253360
## 2017-09-29 -6.213489e-02 -0.0198260355  0.020838892  0.053601273  0.0008958287
## 2017-10-31  9.240381e-02  0.1395154056  0.058252498  0.145700402  0.1109630405
## 2017-11-30  2.007531e-02  0.0626577318  0.004681074 -0.029245089  0.1076142422
## 2017-12-29 -1.536326e-02 -0.0062057845  0.024171700 -0.036583242  0.0207685874
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)

covariance_matrix
##              AAPL         AMZN          GOOG         NVDA           WMT
## AAPL 0.0048301422 0.0015511066  7.578569e-04 0.0020787935  6.412753e-04
## AMZN 0.0015511066 0.0054660218  2.373360e-03 0.0015926723  3.511306e-04
## GOOG 0.0007578569 0.0023733602  2.861289e-03 0.0009259333 -1.110723e-06
## NVDA 0.0020787935 0.0015926723  9.259333e-04 0.0077584880  2.178224e-04
## WMT  0.0006412753 0.0003511306 -1.110723e-06 0.0002178224  2.221393e-03
# Standard deviation of portfolio
# Summarizes how much each asset's returns vary with those of other assets within the portfolio into a single number
w <- c(0.25, 0.25, 0.2, 0.2, 0.1)

sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio
##           [,1]
## [1,] 0.0457934
# Component contribution
# Similar to the formula for sd_portfolio
# Mathematical trick to summarize the same, sd_portfolio, by asset instead of a single number
component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
component_contribution
##            AAPL      AMZN        GOOG      NVDA         WMT
## [1,] 0.01215661 0.0140992 0.006726462 0.0116896 0.001121522
rowSums(component_contribution)
## [1] 0.0457934
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
    round(3) %>%
    as_tibble()

component_percentages
## # A tibble: 1 × 5
##    AAPL  AMZN  GOOG  NVDA   WMT
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.265 0.308 0.147 0.255 0.024
component_percentages %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 AAPL         0.265
## 2 AMZN         0.308
## 3 GOOG         0.147
## 4 NVDA         0.255
## 5 WMT          0.024

4 Component Contribution with a Custom Function

# Transform data into wide form
asset_returns_wide_tbl <- asset_returns_tbl %>%

    pivot_wider(names_from = asset, values_from = returns) %>%

    column_to_rownames(var = "date")

# Custom function
calculate_component_contribution <- function(asset_returns_wide_tbl, w) {

    # Covariance of asset returns
    covariance_matrix <- cov(asset_returns_wide_tbl)
    
    # Standard deviation of portfolio
    sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)

    # Component contribution
    component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]

    # Component contribution in percentage
    component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
        round(3) %>%
        as_tibble()
    
    return(component_percentages)

}

asset_returns_wide_tbl %>% calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1))
## # A tibble: 1 × 5
##    AAPL  AMZN  GOOG  NVDA   WMT
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.265 0.308 0.147 0.255 0.024

5 Visualizing Component Contribution

# Figure 10.1 Contribution to Standard Deviation ----
asset_returns_wide_tbl %>%

    calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1)) %>%
    gather(key = "asset", value = "contribution") %>%

    ggplot(aes(asset, contribution)) +
    geom_col(fill = "cornflowerblue") +
    
    theme(plot.title = element_text(hjust = 0.5)) +
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
    
    labs(title = "Percent Contribution to Portfolio Standard Deviation",
         y = "Percent Contribution to Risk",
         x = NULL)

# Figure 10.2 Weight versus Contribution ----
asset_returns_wide_tbl %>%

    calculate_component_contribution(w = c(0.25,0.25,0.2,0.2,0.1)) %>%
    gather(key = "asset", value = "contribution") %>%
    add_column(weights = c(0.25,0.25,0.2,0.2,0.1)) %>%
    pivot_longer(cols = c(contribution, weights), names_to = "type", values_to = "value") %>%

    ggplot(aes(asset, value, fill = type)) +
    geom_col(position = "dodge") +
    
    theme(plot.title = element_text(hjust = 0.5)) +
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
    theme_tq() +
    scale_fill_tq() +

    labs(title = "Percent Contribution to Volatility",
         y = "percent",
         x = "asset")

6 Rolling Component Contribution

calculate_comp_contrib_by_window <- function(asset_returns_wide_tbl,
                                             start = 1,
                                             window = 24,
                                             weights) {

    # 1 Define start date
    start_date <- rownames(asset_returns_wide_tbl)[start]

    # 2 Define end date
    end_date <- rownames(asset_returns_wide_tbl)[start + window]

    # 3 Subset df
    df_subset <- asset_returns_wide_tbl %>%

        rownames_to_column(var = "date") %>%

        filter(date >= start_date & date < end_date) %>%

        column_to_rownames(var = "date")

    # 4 Calculate component contribution
    component_percentages <-df_subset %>%
        calculate_component_contribution(w = weights)

    # 5 Add end date to df
    component_percentages %>%

        mutate(date = ymd(end_date)) %>%
        select(date, everything())

}


# Check the custom function
asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 1, window = 24,
                                                            w = c(0.25,0.25,0.2,0.2,0.1))
## # A tibble: 1 × 6
##   date        AAPL  AMZN  GOOG  NVDA   WMT
##   <date>     <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 0.316 0.369 0.106 0.159  0.05
asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 2, window = 24,
                                                            w = c(0.25,0.25,0.2,0.2,0.1))
## # A tibble: 1 × 6
##   date        AAPL  AMZN  GOOG  NVDA   WMT
##   <date>     <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27 0.293 0.398 0.113 0.147 0.049
# Iterate the custom function
w <- c(0.25,0.25,0.2,0.2,0.1)
window <- 24

rolling_comp_contrib_tbl <- 1:(nrow(asset_returns_wide_tbl) - window) %>%

    map_df(.x = ., .f = ~calculate_comp_contrib_by_window(asset_returns_wide_tbl,
                                                          start = .x,
                                                          weights = w,
                                                          window = window))
rolling_comp_contrib_tbl
## # A tibble: 36 × 6
##    date        AAPL  AMZN  GOOG  NVDA   WMT
##    <date>     <dbl> <dbl> <dbl> <dbl> <dbl>
##  1 2015-01-30 0.316 0.369 0.106 0.159 0.05 
##  2 2015-02-27 0.293 0.398 0.113 0.147 0.049
##  3 2015-03-31 0.29  0.385 0.113 0.17  0.042
##  4 2015-04-30 0.291 0.374 0.113 0.178 0.043
##  5 2015-05-29 0.286 0.38  0.111 0.181 0.041
##  6 2015-06-30 0.288 0.379 0.109 0.18  0.044
##  7 2015-07-31 0.263 0.378 0.115 0.195 0.049
##  8 2015-08-31 0.205 0.414 0.159 0.178 0.044
##  9 2015-09-30 0.228 0.409 0.154 0.161 0.048
## 10 2015-10-30 0.237 0.404 0.155 0.157 0.047
## # ℹ 26 more rows
# Figure 10.3 Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%

    # Transform data to long form
    pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%

    # Plot
    ggplot(aes(date, contribution, color = asset)) +
    geom_line() +

    scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
    scale_y_continuous(labels = scales::percent_format()) +

    annotate(geom = "text",
             x = as.Date("2016-07-01"),
             y = 0.03,
             color = "red", size = 5,
             label = str_glue("AGG dips below zero sometimes, indicating
                              it reduces the portfolio volatility."))

# Figure 10.4 Stacked Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%

    # Transform data to long form
    pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%

    # Plot
    ggplot(aes(date, contribution, fill = asset)) +
    geom_area() +

    scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
    scale_y_continuous(labels = scales::percent_format()) +

    annotate(geom = "text",
             x = as.Date("2016-07-01"),
             y = 0.08,
             color = "red", size = 5,
             label = str_glue("AGG dips below zero sometimes, indicating
                              it reduces the portfolio volatility."))

Which of the assets in your portfolio the largest contributor to the portfolio volatility? Do you think your portfolio risk is concentrated in any one asset?

NVDA is the largest contributor to volatility, this is obvious because NVDA has some large losses and some large returns. Most of the risk is in NVDA but ther is smaller amounts of risk with AMZN and GOOG.