# 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("MSFT", "JPM", "GM", "TMUS", "IRVRF")

prices <- tq_get(x    = symbols, 
                get  = "stock.prices",
                from = "2017-12-31", 
                to   = "2022-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
##                      GM        IRVRF          JPM         MSFT          TMUS
## 2018-02-28 -0.074888292  0.229788094 -0.001470674 -0.008450792 -0.0714646060
## 2018-03-29 -0.069456877  0.014246816 -0.049063175 -0.027022824  0.0070694909
## 2018-04-30  0.010947126  0.161430198 -0.005821730  0.024353128 -0.0087207958
## 2018-05-31  0.150332749 -0.131417227 -0.016405251  0.059652055 -0.0828284427
## 2018-06-29 -0.071745311 -0.042054715 -0.026610130 -0.002329544  0.0701890259
## 2018-07-31 -0.038551007 -0.122889665  0.103604599  0.073020819  0.0041753714
## 2018-08-31 -0.050308230  0.050981913 -0.003223842  0.061088280  0.0959160720
## 2018-09-28 -0.057473332 -0.080042708 -0.015302261  0.017998038  0.0608027360
## 2018-10-31  0.083167953  0.248461359 -0.027461443 -0.068387211 -0.0234999204
## 2018-11-30  0.036494597  0.237440856  0.019709349  0.041797849 -0.0014599419
## 2018-12-31 -0.115758234  0.070043844 -0.130158039 -0.087790723 -0.0733328015
## 2019-01-31  0.154022702 -0.007380107  0.066577174  0.027768884  0.0902812191
## 2019-02-28  0.011719745  0.035653103  0.008274779  0.074511393  0.0365266011
## 2019-03-29 -0.052301753 -0.009335795 -0.030451025  0.051409367 -0.0440238248
## 2019-04-30  0.048661900  0.192371893  0.144248568  0.101963136  0.0547677162
## 2019-05-31 -0.155520991  0.223143551 -0.090959489 -0.050746857  0.0061463555
## 2019-06-28  0.155338497  0.104360015  0.053649849  0.079843829  0.0094864107
## 2019-07-31  0.045906401 -0.030490167  0.043933376  0.017096989  0.0726907799
## 2019-08-30 -0.083996251 -0.112709682 -0.054383220  0.014924816 -0.0212962787
## 2019-09-30  0.020447073 -0.093331940  0.068847195  0.008450635  0.0091824902
## 2019-10-31 -0.008574491 -0.050149784  0.067598200  0.030739309  0.0482036818
## 2019-11-29 -0.031713933  0.179937765  0.053308439  0.057761464 -0.0510004546
## 2019-12-31  0.027200399  0.150393203  0.056365422  0.040901281 -0.0016564315
## 2020-01-31 -0.091791587  0.323183986 -0.045422566  0.076455906  0.0097710821
## 2020-02-28 -0.090529858 -0.354469123 -0.130987511 -0.046764676  0.1297358606
## 2020-03-31 -0.371610449 -0.413975798 -0.254395072 -0.026900198 -0.0719602768
## 2020-04-30  0.070147146  0.245456850  0.072039820  0.127800305  0.0454358975
## 2020-05-29  0.149332229  0.046063998  0.016056709  0.025074439  0.1305085812
## 2020-06-30 -0.022666049  0.216994416 -0.033968913  0.104863788  0.0402620709
## 2020-07-31 -0.016338254  0.121801337  0.036757421  0.007343516  0.0305417301
## 2020-08-31  0.174321260  0.003407158  0.036075535  0.097808848  0.0830612279
## 2020-09-30 -0.001350903 -0.229541526 -0.039911606 -0.069775565 -0.0200837688
## 2020-10-30  0.154392090 -0.140832263  0.027455206 -0.038085909 -0.0427877618
## 2020-11-30  0.238718071 -0.099901987  0.184291697  0.058326194  0.1933342992
## 2020-12-31 -0.051485344  0.101378728  0.075071015  0.038264089  0.0142651804
## 2021-01-29  0.196470070 -0.277730118  0.019688740  0.041997604 -0.0672464521
## 2021-02-26  0.012744016  0.098845835  0.134337374  0.004109520 -0.0496749221
## 2021-03-31  0.112813668 -0.035932009  0.033804184  0.014482781  0.0433893384
## 2021-04-30 -0.004185538 -0.056441311  0.016197733  0.067286304  0.0531552660
## 2021-05-28  0.035874490  0.068562671  0.065610895 -0.007656462  0.0681599523
## 2021-06-30 -0.002363368 -0.199332903 -0.054425916  0.081569597  0.0236143781
## 2021-07-30 -0.040174328 -0.045120435 -0.018724670  0.050423720 -0.0056084480
## 2021-08-31 -0.148215930 -0.088410957  0.052429139  0.059768656 -0.0498252768
## 2021-09-30  0.072780782 -0.317823678  0.023113081 -0.068406103 -0.0699734102
## 2021-10-29  0.032110282 -0.028104894  0.043184518  0.162366182 -0.1049605643
## 2021-11-30  0.061283644 -0.051168287 -0.067316743 -0.001282830 -0.0555897316
## 2021-12-31  0.013047420  0.252702354 -0.003026526  0.017184162  0.0638145647
## 2022-01-31 -0.106061923 -0.176899390 -0.057573317 -0.078334420 -0.0697137432
## 2022-02-28 -0.121012294  0.089711475 -0.046840548 -0.037922168  0.1301861634
## 2022-03-31 -0.065909195  0.003172927 -0.039412533  0.031364809  0.0408707455
## 2022-04-29 -0.143048147  0.354560778 -0.125475961 -0.105212880 -0.0414390427
## 2022-05-31  0.020107727 -0.486434171  0.102398707 -0.018242486  0.0792052417
## 2022-06-30 -0.197115037 -0.075035186 -0.160612271 -0.056909618  0.0093343475
## 2022-07-29  0.132507571  0.115182254  0.032933899  0.089014488  0.0614026081
## 2022-08-31  0.054662548 -0.132209515 -0.014230509 -0.068988966  0.0062714231
## 2022-09-30 -0.174552744 -0.283726893 -0.084640148 -0.115710390 -0.0704278941
## 2022-10-31  0.201406997  0.222441551  0.195049196 -0.003311601  0.1218739353
## 2022-11-30  0.032830989 -0.144830948  0.093227977  0.097329063 -0.0006599631
## 2022-12-30 -0.184845245  0.149035579 -0.029971238 -0.061923768 -0.0786791873
calculate_component_contribution <-  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
    sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
    
    # 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 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
##      GM IRVRF   JPM  MSFT  TMUS
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.262 0.456 0.153 0.094 0.034

6 Plot: Colum Chart of Component Contribution and Weight

plot_data <- asset_returns_wide_tbl %>% 
    
    calculate_component_contribution(w = c(0.25, 0.25, 0.2, 0.2, 0.1)) %>% 
    
    # Transform to long form
    pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>% 
    
    # Add weights
    add_column(weight = c(0.25, 0.25, 0.2, 0.2, 0.1)) %>% 
    
    # Transform to long
    pivot_longer(cols = c(Contribution, weight), names_to = "type", values_to = "value")


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?

Of the five assets in my portfolio, Irving Resources Inc. (IRVRF) has the heaviest contribution to the portfolios volatility, given its 0.25 weight. IRVRF has nearly half, (47%) of the contribution to the portfolios overall volatility, indicating that there is downside risk with being overly weighted in this asset. In comparison to some of the other assets in the portfolio, it would be wise to rebalance the allocation of TMUS and MSFT to 0.25 for each. Since these assets have very low contribution to the portfolios volatility, there is more incentive to have a increase their weighting. Additionally, I would adjust IRVRF to have a 0.1 weighting, and GM to have 0.2. These updates should poise the portfolio to have an evenly dispersed weighting without having risk concentrated in any one asset.