# 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("MCD", "ISRG", "KHC", "FIS", "GOOG")

prices <- tq_get(x    = symbols,
                 get  = "stock.prices",    
                 from = "2015-12-31",
                 to   = "2024-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
##                      FIS          GOOG         ISRG           KHC           MCD
## 2016-01-29 -0.0144602685 -0.0212148962 -0.009770000  0.0703111270  4.663510e-02
## 2016-02-29 -0.0250903318 -0.0627392605  0.040244210 -0.0134123049 -4.716187e-02
## 2016-03-31  0.0874479419  0.0654275963  0.065291935  0.0272177943  6.994241e-02
## 2016-04-29  0.0385764274 -0.0722726559  0.041247205 -0.0062570215  6.424206e-03
## 2016-05-31  0.1210876184  0.0598051735  0.013242841  0.0703718367 -3.565045e-02
## 2016-06-30 -0.0044295048 -0.0611191121  0.041205727  0.0616496844 -6.868106e-03
## 2016-07-29  0.0764028516  0.1050873292  0.050630842 -0.0239046431 -2.260682e-02
## 2016-08-31 -0.0025178019 -0.0022657966 -0.013515028  0.0419837211 -9.317996e-03
## 2016-09-30 -0.0260255792  0.0132615302  0.054447442  0.0002231051 -2.596974e-03
## 2016-10-31 -0.0412115125  0.0092841056 -0.075559809 -0.0062758487 -2.448229e-02
## 2016-11-30  0.0432867222 -0.0343615135 -0.043082448 -0.0784637880  6.556082e-02
## 2016-12-30 -0.0168279027  0.0180152337 -0.014977836  0.0671377283  2.033330e-02
## 2017-01-31  0.0487650261  0.0318397939  0.088265485  0.0223101087  6.958965e-03
## 2017-02-28  0.0352562967  0.0326200945  0.062005312  0.0245587143  4.794339e-02
## 2017-03-31 -0.0292177016  0.0076842168  0.039207670 -0.0011007618  1.523789e-02
## 2017-04-28  0.0558105158  0.0880997230  0.086677563 -0.0046357227  7.661224e-02
## 2017-05-31  0.0197584933  0.0629877923  0.090101194  0.0265823092  7.540881e-02
## 2017-06-30 -0.0021005785 -0.0599350111  0.022367898 -0.0738076247  2.118141e-02
## 2017-07-31  0.0659281736  0.0236741629  0.003084947  0.0210291485  1.284488e-02
## 2017-08-31  0.0184645669  0.0094446934  0.068387261 -0.0725917864  3.657367e-02
## 2017-09-29  0.0081883563  0.0208389738  0.040199500 -0.0404353940 -2.078104e-02
## 2017-10-31 -0.0067688345  0.0582525835  0.073883993 -0.0028410117  6.324932e-02
## 2017-11-30  0.0167838350  0.0046809400  0.063028767  0.0588898003  3.580872e-02
## 2017-12-29  0.0005338183  0.0241716390 -0.091181391 -0.0453793207  8.721283e-04
## 2018-01-31  0.0842443668  0.1115967900  0.167928440  0.0080688502 -5.709800e-03
## 2018-02-28 -0.0519312029 -0.0573515298 -0.012166319 -0.1562575131 -7.522761e-02
## 2018-03-29 -0.0059017977 -0.0683057993 -0.032459193 -0.0643296389 -8.658871e-03
## 2018-04-30 -0.0139073046 -0.0141136248  0.065509992 -0.0996864326  6.833595e-02
## 2018-05-31  0.0735665555  0.0643892525  0.041962922  0.0299201163 -4.538871e-02
## 2018-06-29  0.0395869392  0.0278664749  0.040105600  0.0888363439 -1.463493e-02
## 2018-07-31 -0.0277319150  0.0871651755  0.060240994 -0.0417712581  5.410037e-03
## 2018-08-31  0.0477137194  0.0007637297  0.097081413 -0.0227816015  3.555920e-02
## 2018-09-28  0.0112124143 -0.0205011698  0.024692559 -0.0557561942  3.071322e-02
## 2018-10-31 -0.0466378315 -0.1028991445 -0.096533883 -0.0025436381  5.585597e-02
## 2018-11-30  0.0363162524  0.0162678540  0.018421674 -0.0606674061  6.971454e-02
## 2018-12-31 -0.0483151375 -0.0552431428 -0.102983596 -0.1720457120 -5.978598e-02
## 2019-01-31  0.0191236605  0.0750917804  0.089270830  0.1103199698  6.790842e-03
## 2019-02-28  0.0340449889  0.0031748651  0.044758961 -0.3702015715  3.425630e-02
## 2019-03-29  0.0480112428  0.0465716243  0.041090008 -0.0041562014  3.243163e-02
## 2019-04-30  0.0247140960  0.0128463578 -0.111008067  0.0179090873  3.959560e-02
## 2019-05-31  0.0370022318 -0.0740704060 -0.093930544 -0.1700830739  9.375971e-03
## 2019-06-28  0.0224886230 -0.0208014640  0.120826034  0.1156509382  4.627223e-02
## 2019-07-31  0.0826475582  0.1183224942 -0.009654738  0.0307717061  1.462830e-02
## 2019-08-30  0.0220442337 -0.0237704414 -0.015851295 -0.2109055116  3.910077e-02
## 2019-09-30 -0.0230587930  0.0256755038  0.054404763  0.0904179849 -1.506911e-02
## 2019-10-31 -0.0075607599  0.0331681100  0.023828060  0.1461152631 -8.760851e-02
## 2019-11-29  0.0473577963  0.0349734427  0.069758164 -0.0461840965 -4.962410e-03
## 2019-12-31  0.0093677700  0.0242707879 -0.002955933  0.0520634905  1.596635e-02
## 2020-01-31  0.0323281634  0.0701848929 -0.054525933 -0.0956214741  7.954027e-02
## 2020-02-28 -0.0278091724 -0.0684586298 -0.047222961 -0.1645357567 -9.086332e-02
## 2020-03-31 -0.1359387545 -0.1413300093 -0.075338954  0.0158389392 -1.606697e-01
## 2020-04-30  0.0809026999  0.1482721074  0.031152779  0.2037159466  1.260346e-01
## 2020-05-29  0.0512815546  0.0578073650  0.126945112  0.0175798877  1.200023e-05
## 2020-06-30 -0.0322572756 -0.0107722179 -0.017741803  0.0455498866 -9.978989e-03
## 2020-07-31  0.0872162256  0.0478934005  0.184722902  0.0751826450  5.181368e-02
## 2020-08-31  0.0305583031  0.0971010982  0.064133583  0.0304080522  1.002633e-01
## 2020-09-30 -0.0220659803 -0.1061508709 -0.029577647 -0.1569610223  2.757631e-02
## 2020-10-30 -0.1668318644  0.0980590834 -0.061706903  0.0211438753 -3.001457e-02
## 2020-11-30  0.1749507747  0.0826847480  0.084708885  0.0859088658  2.655691e-02
## 2020-12-31 -0.0455860188 -0.0050446216  0.119365757  0.0508986494 -1.324051e-02
## 2021-01-29 -0.1360995131  0.0467581267 -0.090063045 -0.0337425680 -3.191390e-02
## 2021-02-26  0.1113363579  0.1039617314 -0.014605068  0.0821752917 -2.079215e-03
## 2021-03-31  0.0214203217  0.0154771604  0.002900241  0.1050360709  8.371535e-02
## 2021-04-30  0.0837937251  0.1527899045  0.157512791  0.0317409654  5.189986e-02
## 2021-05-28 -0.0259721895  0.0005974250 -0.026735819  0.0633023190 -3.811915e-03
## 2021-06-30 -0.0476205247  0.0385416519  0.087988549 -0.0666361086 -1.247650e-02
## 2021-07-30  0.0507813874  0.0760718346  0.075196324 -0.0583127982  4.949268e-02
## 2021-08-31 -0.1540501714  0.0730045198  0.060751616 -0.0555015460 -1.640077e-02
## 2021-09-30 -0.0458324513 -0.0875715395 -0.058042117  0.0227999616  1.525419e-02
## 2021-10-29 -0.0942094989  0.1066948649  0.085962212 -0.0255826628  1.824742e-02
## 2021-11-30 -0.0579981872 -0.0400332042 -0.107445681 -0.0544050994  1.652123e-03
## 2021-12-31  0.0472576835  0.0155159766  0.102365323  0.0659137745  9.162387e-02
## 2022-01-31  0.0941017318 -0.0640854435 -0.234549846 -0.0027896683 -3.268394e-02
## 2022-02-28 -0.2305298612 -0.0059683911  0.021410346  0.0912391571 -5.269761e-02
## 2022-03-31  0.0581892479  0.0346685444  0.038348668  0.0148570113  1.020235e-02
## 2022-04-29 -0.0127274766 -0.1944949638 -0.231648821  0.0790462063  7.573919e-03
## 2022-05-31  0.0525531399 -0.0081002558 -0.049952577 -0.1093749246  1.216687e-02
## 2022-06-30 -0.1264519274 -0.0417810722 -0.125904317  0.0081610080 -1.583272e-02
## 2022-07-29  0.1083449095  0.0643327736  0.136957045 -0.0349508342  6.465742e-02
## 2022-08-31 -0.1116228390 -0.0663691728 -0.112204896  0.0256912755 -3.756157e-02
## 2022-09-30 -0.1844448308 -0.1268135622 -0.093154455 -0.1146130071 -8.924795e-02
## 2022-10-31  0.0936608997 -0.0156179604  0.273781480  0.1428211797  1.669343e-01
## 2022-11-30 -0.1340306467  0.0692745722  0.092625128  0.0329370717  6.092659e-03
## 2022-12-30 -0.0605780183 -0.1339679747 -0.018815683  0.0339778738 -3.453505e-02
## 2023-01-31  0.1007220927  0.1182712812 -0.076979144 -0.0044314542  1.457838e-02
## 2023-02-28 -0.1690308977 -0.1007318653 -0.068646979 -0.0400202853 -7.380438e-03
## 2023-03-31 -0.1456151025  0.1412534063  0.107681382  0.0035353882  5.778780e-02
## 2023-04-28  0.0777037292  0.0397753062  0.164735908  0.0153966413  5.611861e-02
## 2023-05-31 -0.0732959477  0.1310217643  0.021739257 -0.0271018212 -3.663952e-02
## 2023-06-30  0.0118683680 -0.0196454416  0.105055135 -0.0633852075  5.088760e-02
## 2023-07-31  0.0987943296  0.0956332795 -0.052657987  0.0189740554 -1.761335e-02
## 2023-08-31 -0.0778093573  0.0313565693 -0.036797023 -0.0773242353 -3.660478e-02
## 2023-09-29 -0.0011740206 -0.0408675029 -0.067433791  0.0164847407 -6.506269e-02
## 2023-10-31 -0.1181676696 -0.0509540273 -0.108562639 -0.0669990994 -4.832467e-03
## 2023-11-30  0.1773543880  0.0665317006  0.170094448  0.1212371369  7.832030e-02
## 2023-12-29  0.0329521300  0.0510207183  0.081872267  0.0518912464  5.074139e-02
## 2024-01-31  0.0358086144  0.0061543397  0.114325474  0.0040480226 -1.286435e-02
## 2024-02-29  0.1055372333 -0.0143479204  0.019324538 -0.0511091185  4.169092e-03
## 2024-03-28  0.0748069484  0.0855198700  0.034386368  0.0562753846 -3.598236e-02
## 2024-04-30 -0.0881641095  0.0781716797 -0.074009680  0.0452997748 -3.211141e-02
## 2024-05-31  0.1108226415  0.0550640990  0.081573274 -0.0876473842 -5.321514e-02
## 2024-06-28 -0.0022210471  0.0540905131  0.100986621 -0.0816721044 -9.295894e-03
## 2024-07-31  0.0193185620 -0.0576203452 -0.000539700  0.0887426656  4.060220e-02
## 2024-08-30  0.0705967625 -0.0475462855  0.102560935  0.0176379676  8.401149e-02
## 2024-09-30  0.0200231689  0.0138344637 -0.002764543 -0.0090729199  5.925652e-02
## 2024-10-31  0.0689690280  0.0323671889  0.025264898 -0.0481353394 -4.157357e-02
## 2024-11-22 -0.0415280810 -0.0360824083  0.083779274 -0.0505699792 -6.284423e-03
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)

covariance_matrix
##               FIS         GOOG        ISRG          KHC          MCD
## FIS  0.0059402187 0.0017092584 0.002382731 0.0009993553 0.0015823745
## GOOG 0.0017092584 0.0045764312 0.002699796 0.0013266974 0.0008754322
## ISRG 0.0023827313 0.0026997962 0.007166317 0.0015108733 0.0017794888
## KHC  0.0009993553 0.0013266974 0.001510873 0.0066397005 0.0007423203
## MCD  0.0015823745 0.0008754322 0.001779489 0.0007423203 0.0024083978
# 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.05032657
# 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
##             FIS       GOOG       ISRG         KHC         MCD
## [1,] 0.01364599 0.01224137 0.01265343 0.009084109 0.002701661
rowSums(component_contribution)
## [1] 0.05032657
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
    round(3) %>%
    as_tibble()

component_percentages
## # A tibble: 1 × 5
##     FIS  GOOG  ISRG   KHC   MCD
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.271 0.243 0.251 0.181 0.054
component_percentages %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 FIS          0.271
## 2 GOOG         0.243
## 3 ISRG         0.251
## 4 KHC          0.181
## 5 MCD          0.054

6 Plot: Colum Chart of Component Contribution and Weight

# 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
##     FIS  GOOG  ISRG   KHC   MCD
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.271 0.243 0.251 0.181 0.054

5 Visualizing Component Contribution

# 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")

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

Note: The date had to be changed from 2012 to 2015 because on of my stock picks is newer causing the contribution visuals to not display correctly.

The largest contributor to portfolio volatility in my portfolio is the FIS asset, with GooG following close behind. These two stocks have the highest contribution which means it is also a major drier of the portfolios risk. My portfolio seems to be relatively balanced around 4 out of the 5 asset choices with MCD lagging behind.