# Load packages

# Core
library(tidyverse)
library(tidyquant)

Goal

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

1 Import stock prices

Choose your stocks from 2012-12-31 to present.

symbols <- c("XOM", "SHEL", "BP", "CVX")

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

2 Convert prices to returns (monthly)

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 Calculate Component Contribution to Portfolio Volatility

# 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
##                       BP          CVX          SHEL          XOM
## 2013-01-31  0.0668771943  0.062808866  0.0225147154  0.038754504
## 2013-02-28 -0.0845705869  0.024974876 -0.0587852282  0.001689163
## 2013-03-28  0.0471386953  0.014154336 -0.0074919490  0.006234000
## 2013-04-30  0.0290887667  0.026493459  0.0422205856 -0.012507106
## 2013-05-31 -0.0036234221  0.014078670 -0.0108342049  0.023388410
## 2013-06-28 -0.0276454345 -0.036587980 -0.0394915576 -0.001327708
## 2013-07-31 -0.0072131330  0.061846640  0.0688878707  0.036940700
## 2013-08-30  0.0096059947 -0.036112772 -0.0425806966 -0.065998119
## 2013-09-30  0.0175217992  0.008845684  0.0167352424 -0.012932830
## 2013-10-31  0.1010684998 -0.012755576  0.0151106174  0.040765958
## 2013-11-29  0.0231120763  0.028824901  0.0139694998  0.048950159
## 2013-12-31  0.0334692449  0.019972069  0.0662705541  0.079351335
## 2014-01-31 -0.0360249651 -0.112403673 -0.0309211376 -0.093572407
## 2014-02-28  0.0881401395  0.041451210  0.0659343375  0.050687649
## 2014-03-31 -0.0508669574  0.030569614  0.0026036792  0.014540240
## 2014-04-30  0.0510644833  0.054097715  0.0748703717  0.047287748
## 2014-05-30  0.0081456376 -0.013489713  0.0100740231 -0.011761807
## 2014-06-30  0.0445809175  0.061280619  0.0468495952  0.001491010
## 2014-07-31 -0.0743557383 -0.010084692 -0.0065769171 -0.017433710
## 2014-08-29 -0.0112281226  0.010086790  0.0012631098  0.012184026
## 2014-09-30 -0.0848096707 -0.081485942 -0.0616363084 -0.055929061
## 2014-10-31 -0.0112116936  0.005266214 -0.0586970560  0.027890198
## 2014-11-28 -0.0855967034 -0.087689426 -0.0645922934 -0.058731134
## 2014-12-31 -0.0309946486  0.029950458  0.0080980919  0.020876410
## 2015-01-30  0.0184541847 -0.089949257 -0.0857221678 -0.055944032
## 2015-02-27  0.0797057092  0.049454874  0.0761670042  0.020229040
## 2015-03-31 -0.0578684388 -0.016063781 -0.0915694266 -0.040802932
## 2015-04-30  0.0985362431  0.056300438  0.0614431390  0.027500591
## 2015-05-29 -0.0261663648 -0.065426054 -0.0453894959 -0.016913419
## 2015-06-30 -0.0368503484 -0.065497080 -0.0464403589 -0.023754029
## 2015-07-31 -0.0777718618 -0.086455387  0.0082102495 -0.049144858
## 2015-08-31 -0.0808112149 -0.075930072 -0.0666197631 -0.042106237
## 2015-09-30 -0.0930468617 -0.026397626 -0.1103702449 -0.011899742
## 2015-10-30  0.1554587751  0.141612096  0.1016398989  0.106919431
## 2015-11-30 -0.0150499317  0.016969274 -0.0345687784 -0.004458968
## 2015-12-31 -0.1015140961 -0.015004549 -0.0831457114 -0.046496820
## 2016-01-29  0.0348927656 -0.039567593 -0.0414679925 -0.001283372
## 2016-02-29 -0.0858945457 -0.023065800  0.0555975119  0.038150982
## 2016-03-31  0.0367850577  0.133950661  0.0632598123  0.042024023
## 2016-04-29  0.1067512464  0.068657795  0.0876817214  0.055948174
## 2016-05-31 -0.0485238354 -0.001100026 -0.0681909092  0.015358344
## 2016-06-30  0.1230066901  0.037219564  0.1299677651  0.051663676
## 2016-07-29 -0.0317577527 -0.022672691 -0.0641284226 -0.052450175
## 2016-08-31  0.0022777069 -0.008232644 -0.0385244594 -0.012067449
## 2016-09-30  0.0376750911  0.022998409  0.0236448782  0.001605513
## 2016-10-31  0.0110307140  0.017624771 -0.0052060626 -0.046432600
## 2016-11-30  0.0024877002  0.072947384  0.0440400161  0.055477643
## 2016-12-30  0.0655020407  0.053576233  0.0622122646  0.033343852
## 2017-01-31 -0.0381725461 -0.055460276  0.0001836121 -0.073188079
## 2017-02-28 -0.0414552053  0.019801063 -0.0296397220 -0.022011662
## 2017-03-31  0.0175341217 -0.046672428  0.0160582014  0.008449189
## 2017-04-28 -0.0058102192 -0.006259621 -0.0102937012 -0.004399428
## 2017-05-31  0.0690672205 -0.020521751  0.0585363847 -0.004785675
## 2017-06-30 -0.0423792230  0.008180291 -0.0226774905  0.002853213
## 2017-07-31  0.0140423397  0.045530703  0.0609016215 -0.008584037
## 2017-08-31  0.0048204245 -0.004485457 -0.0076154364 -0.037814165
## 2017-09-29  0.1012345969  0.087831480  0.0933639807  0.071409277
## 2017-10-31  0.0566523178 -0.013796495  0.0396459140  0.016573253
## 2017-11-30 -0.0002641644  0.035715249  0.0321405247  0.008492011
## 2017-12-29  0.0477559718  0.050793334  0.0395982263  0.004193270
calculate_component_contributions <- function(.data, w) {
    
        # Covariance of asset returns
    covariance_matrix <- cov(.data)
    
    # 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.25, 0.25)
    
    sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
    sd_portfolio
    
    
    # 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]
    
    rowSums(component_contribution)
    
    # 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_contributions(w = c(.25, .25, .25, .25))
## # A tibble: 1 × 4
##      BP   CVX  SHEL   XOM
##   <dbl> <dbl> <dbl> <dbl>
## 1 0.287 0.249 0.273 0.191

6 Plot: Colum Chart of Component Contribution and Weight

plot_data <- asset_returns_wide_tbl %>%
    
    calculate_component_contributions(w = c(.28, .32, .2, .2)) %>%
    
    # Transform to long form
    pivot_longer(cols = everything(),names_to = "Asset", values_to = "Contribution") %>%
    
    # Add weights
    add_column(weight = c(.28, .32, .2, .2)) %>%
    
    # Transform to long
    pivot_longer(cols = c(Contribution, weight), names_to = "type", values_to = "value")

plot_data
## # A tibble: 8 × 3
##   Asset type         value
##   <chr> <chr>        <dbl>
## 1 BP    Contribution 0.287
## 2 BP    weight       0.28 
## 3 CVX   Contribution 0.249
## 4 CVX   weight       0.32 
## 5 SHEL  Contribution 0.273
## 6 SHEL  weight       0.2  
## 7 XOM   Contribution 0.191
## 8 XOM   weight       0.2
plot_data %>%
    
    ggplot(aes(x = Asset, y = value, fill = type)) + 
    geom_col(position = "dodge") + 
    
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) + 
    scale_fill_tq() +
    theme(plot.title = element_text(hjust = 0.5)) + 
    theme_tq() +
    
    labs(title = "Percent Contribution to Portfolio Volatility and Weight", y = "Percent", x = NULL)

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?

It seems that most of the risk is consolidated into BP as it has the largest contribution to volatility. Shel, despite having a smaller allocation, comprises a very large portion of the portfolio’s overall volatility and certainly contributes the most when adjusted for weight. Decreasing allocation in Shel and BP and increasing reallocating to CVX or XOM both of which have low volatility relative to their weights would decrease the portfolio’s volatility significantly.