# Load packages

# Core
library(tidyverse)
library(tidyquant)
library(broom)
library(lubridate)
library(tibbletime)

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("BA", "JPM", "COKE", "PG", "UNH")

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

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
##                      BA          COKE          JPM            PG           UNH
## 2013-01-31 -0.019970011 -0.0231477659  0.074549341  0.1098051680  0.0177253198
## 2013-02-28  0.046601648  0.0107558495  0.038975606  0.0134797588 -0.0323975552
## 2013-03-28  0.110096133 -0.0813168649 -0.030299140  0.0114854498  0.0718558489
## 2013-04-30  0.062752965  0.0193732394  0.038370073  0.0035496751  0.0464490888
## 2013-05-31  0.085096968 -0.0241252737  0.107826278 -0.0001303103  0.0440670216
## 2013-06-28  0.033955442  0.0224914874 -0.033528923  0.0029920934  0.0488965475
## 2013-07-31  0.025634735  0.0472328342  0.061462956  0.0495570922  0.1066575332
## 2013-08-30 -0.006749615 -0.0161013084 -0.097951530 -0.0304720424 -0.0153541587
## 2013-09-30  0.122816962 -0.0044657861  0.022697323 -0.0299741202  0.0019455684
## 2013-10-31  0.104935079  0.0159953096  0.004433691  0.0738222333 -0.0479110735
## 2013-11-29  0.031968120  0.0698347275  0.104545588  0.0420742810  0.0872071710
## 2013-12-31  0.016547512  0.0750225925  0.021781459 -0.0339343555  0.0147540036
## 2014-01-31 -0.085859511 -0.0658059418 -0.048308895 -0.0531034783 -0.0409325212
## 2014-02-28  0.034424543  0.1023680763  0.026031172  0.0262767131  0.0667578766
## 2014-03-31 -0.026966002  0.1164307057  0.066220069  0.0243639188  0.0628982293
## 2014-04-30  0.027741546 -0.0298913313 -0.074830766  0.0318635508 -0.0885763209
## 2014-05-30  0.052752773 -0.0885713800 -0.007351098 -0.0215513691  0.0593699481
## 2014-06-30 -0.061128289 -0.0213531142  0.036226201 -0.0276087911  0.0309635150
## 2014-07-31 -0.054512757 -0.0501329299  0.007833673 -0.0083351779 -0.0085997013
## 2014-08-29  0.057164930  0.0629976702  0.030398520  0.0722123967  0.0671569241
## 2014-09-30  0.004563935  0.0036239137  0.013201021  0.0075521516 -0.0007298658
## 2014-10-31 -0.019581574  0.1950205022  0.010690736  0.0489298959  0.0967323595
## 2014-11-28  0.078747216  0.0445479153 -0.005305044  0.0355694234  0.0373933633
## 2014-12-31 -0.033142056 -0.0715567413  0.039438299  0.0072719576  0.0283992465
## 2015-01-30  0.111901379  0.1049931889 -0.134036997 -0.0704973193  0.0497834240
## 2015-02-27  0.043169954  0.0678712085  0.119457193  0.0099163609  0.0671527414
## 2015-03-31 -0.005117501  0.0797850451 -0.011488761 -0.0381920858  0.0435318661
## 2015-04-30 -0.045949076  0.0016653936  0.049912904 -0.0220931712 -0.0600119938
## 2015-05-29 -0.013481423  0.0050316244  0.039062668 -0.0141868716  0.0761129117
## 2015-06-30 -0.012892611  0.2853242467  0.029656331 -0.0019152405  0.0190073285
## 2015-07-31  0.038535895  0.0714470355  0.017814310 -0.0117241017 -0.0049299113
## 2015-08-31 -0.091881921 -0.0491513342 -0.066827368 -0.0818807663 -0.0480903482
## 2015-09-30  0.002064023  0.2262123434 -0.050062322  0.0178115640  0.0069921448
## 2015-10-30  0.122869949  0.0893980363  0.059589075  0.0688359404  0.0151418335
## 2015-11-30 -0.011689080 -0.0866970434  0.037123456 -0.0203686650 -0.0440002424
## 2015-12-31 -0.005930187 -0.0593511363 -0.009795720  0.0592721820  0.0471209415
## 2016-01-29 -0.185327767 -0.0354204563 -0.097446935  0.0369855681 -0.0213066322
## 2016-02-29 -0.007154361 -0.0067306900 -0.055281821 -0.0172865832  0.0336409682
## 2016-03-31  0.071505655 -0.0895123650  0.050564695  0.0248477235  0.0831916750
## 2016-04-29  0.060077658 -0.0008895991  0.072421503 -0.0188088087  0.0213378546
## 2016-05-31 -0.058196806 -0.2549871829  0.032228124  0.0114168836  0.0149993313
## 2016-06-30  0.029062306  0.1773838478 -0.049142543  0.0438187895  0.0593468768
## 2016-07-29  0.028765318 -0.0332200133  0.036778654  0.0186128990  0.0140649397
## 2016-08-31 -0.023751684  0.0539230274  0.053713298  0.0198963587 -0.0512198749
## 2016-09-30  0.017535589 -0.0143407311 -0.013573014  0.0275630444  0.0332268734
## 2016-10-31  0.078020439 -0.0456853269  0.046556186 -0.0257303174  0.0094553698
## 2016-11-30  0.063160659  0.1353518657  0.146281893 -0.0512930818  0.1174948104
## 2016-12-30  0.033441199  0.1003101164  0.073564141  0.0194550603  0.0108052806
## 2017-01-31  0.048520839 -0.0561206664 -0.013906614  0.0489062225  0.0127896514
## 2017-02-28  0.106475346  0.0189498842  0.068385744  0.0388479487  0.0200323786
## 2017-03-31 -0.018875281  0.1800717305 -0.031157793 -0.0134870367 -0.0045980355
## 2017-04-28  0.044078039  0.0291591535 -0.003879530 -0.0208194194  0.0641728092
## 2017-05-31  0.022661861  0.0722789247 -0.057361548  0.0086650778  0.0017139596
## 2017-06-30  0.052531570  0.0049498633  0.106698950 -0.0107284028  0.0609307989
## 2017-07-31  0.203833070  0.0489101037  0.009852355  0.0490634830  0.0338818972
## 2017-08-31 -0.005668744 -0.1169556248 -0.009962463  0.0158396723  0.0362966023
## 2017-09-29  0.058939424  0.0100617715  0.049581119 -0.0140794083 -0.0116649032
## 2017-10-31  0.014721449  0.0455855769  0.057849137 -0.0448810987  0.0708052539
## 2017-11-30  0.075774347 -0.0446511382  0.038126708  0.0414055525  0.0853071090
## 2017-12-29  0.063374990 -0.0020882289  0.022889454  0.0207845581 -0.0343750181
## 2018-01-31  0.183671320 -0.0597908106  0.083669075 -0.0545956441  0.0714153882
## 2018-02-28  0.026806721 -0.0818179716 -0.001470744 -0.0949399573 -0.0458886603
## 2018-03-29 -0.099576293 -0.0776383652 -0.049062945  0.0096326274 -0.0519613453
## 2018-04-30  0.017175095 -0.0235897866 -0.005821718 -0.0823975379  0.0995492950
## 2018-05-31  0.059238873 -0.2788724371 -0.016405339  0.0114085327  0.0213855282
## 2018-06-29 -0.048433681  0.0588270977 -0.026610415  0.0646922324  0.0192653875
## 2018-07-31  0.060121150  0.0731341223  0.103605062  0.0445230759  0.0316137078
## 2018-08-31 -0.033725945  0.1556460822 -0.003224137  0.0252716262  0.0584432288
## 2018-09-28  0.081506780  0.0723372406 -0.015302271  0.0033700331 -0.0056870360
## 2018-10-31 -0.046901725 -0.0529126070 -0.027461087  0.0722240596 -0.0177860671
## 2018-11-30 -0.018483177  0.2078855801  0.019708972  0.0636710431  0.0769646834
## 2018-12-31 -0.072529760 -0.1807415772 -0.130157857 -0.0277868975 -0.1217002684
## 2019-01-31  0.178749274  0.1972273799  0.066577223  0.0561915702  0.0812280126
## 2019-02-28  0.136842655  0.1385120551  0.008274895  0.0213319479 -0.1093160740
## 2019-03-29 -0.142782634  0.1495061789 -0.030451499  0.0543077450  0.0244035577
## 2019-04-30 -0.009827546  0.1223278982  0.144249066  0.0301201724 -0.0591016807
## 2019-05-31 -0.094675264 -0.0734572273 -0.090959646 -0.0341026093  0.0367720402
## 2019-06-28  0.063511617 -0.0091810041  0.053649831  0.0634388245  0.0135169134
## 2019-07-31 -0.064771130 -0.0184376998  0.043933279  0.0801852216  0.0202838698
## 2019-08-30  0.071211483  0.1369448121 -0.054383227  0.0183829929 -0.0621719335
## 2019-09-30  0.044006196 -0.1023249571  0.068847307  0.0339348396 -0.0692455606
## 2019-10-31 -0.112726399 -0.1012363389  0.067598155  0.0074121316  0.1508321075
## 2019-11-29  0.080262991 -0.0154266354  0.053308551 -0.0198734670  0.1021220201
## 2019-12-31 -0.116964019  0.0501357595  0.056365365  0.0230009324  0.0530241278
## 2020-01-31 -0.023260958 -0.0468452281 -0.045422622  0.0036792415 -0.0760565073
## 2020-02-28 -0.139796995 -0.3213661852 -0.130987394 -0.0958479111 -0.0663487713
## 2020-03-31 -0.612285506  0.0600312927 -0.254395229 -0.0289408906 -0.0178065811
## 2020-04-30 -0.055983703  0.1226188677  0.072040116  0.0757488615  0.1593843536
## 2020-05-29  0.033676984  0.0332458922  0.016056494 -0.0166820370  0.0414577343
## 2020-06-30  0.228545433 -0.0602780992 -0.033968801  0.0310016812 -0.0287160676
## 2020-07-31 -0.148529138  0.0027120985  0.036757252  0.0985015938  0.0262001605
## 2020-08-31  0.083852427  0.1744054011  0.036075480  0.0535292629  0.0317581195
## 2020-09-30 -0.038927502 -0.1271016158 -0.039911373  0.0047598477  0.0016133036
## 2020-10-30 -0.135001990 -0.0489600512  0.027455387 -0.0081544062 -0.0214948117
## 2020-11-30  0.377964845  0.1336566754  0.184291517  0.0128277737  0.0973515882
## 2020-12-31  0.015773526  0.0173505671  0.075070855  0.0019421963  0.0453430818
## 2021-01-29 -0.097419264  0.0031895432  0.019688697 -0.0757971686 -0.0499915305
## 2021-02-26  0.087796344 -0.0389717034  0.134337505 -0.0371856913 -0.0040852423
## 2021-03-31  0.183531490  0.1179125022  0.033804093  0.0919708941  0.1168309182
## 2021-04-30 -0.083519893  0.0161597073  0.016197993 -0.0085751569  0.0693781547
## 2021-05-28  0.052824308  0.3226641390  0.065610819  0.0106608330  0.0323691907
## 2021-06-30 -0.030665425 -0.0069140432 -0.054426039  0.0005931010 -0.0246095479
## 2021-07-30 -0.056147275 -0.0068273654 -0.018724684  0.0589589776  0.0289934176
## 2021-08-31 -0.031304389  0.0174099627  0.052429295  0.0011244144  0.0097769176
## 2021-09-30  0.002002560 -0.0299396230  0.023112965 -0.0183568979 -0.0597879246
## 2021-10-29 -0.060491089  0.0187792683  0.043184571  0.0287418749  0.1642052397
## 2021-11-30 -0.045354506  0.3516772957 -0.067316767  0.0110584003 -0.0359276774
## 2021-12-31  0.017386520  0.0817766187 -0.003026627  0.1234694370  0.1258153469
## 2022-01-31 -0.005379044 -0.0770990617 -0.057573178 -0.0139352406 -0.0606931462
## 2022-02-28  0.025150449 -0.1424364689 -0.046840792 -0.0288318692  0.0069589397
## 2022-03-31 -0.069779315 -0.0001609923 -0.039412576 -0.0200206737  0.0721619734
## 2022-04-29 -0.252015930 -0.1175819897 -0.125475837  0.0550702395 -0.0027883387
## 2022-05-31 -0.124625819  0.2465945957  0.102398675 -0.0822043623 -0.0234162481
## 2022-06-30  0.039688988 -0.0018955429 -0.160612206 -0.0280471793  0.0369156335
## 2022-07-29  0.152916927 -0.0941080181  0.032933922 -0.0280568660  0.0543899510
## 2022-08-31  0.005883122 -0.0783726899 -0.014230606 -0.0070073321 -0.0433536318
## 2022-09-30 -0.280283597 -0.1415355650 -0.084640060 -0.0885547361 -0.0247689259
## 2022-10-31  0.162960635  0.1684493509  0.195049105  0.0716349287  0.0946007096
## 2022-11-30  0.227303083  0.0097874924  0.093228161  0.1021924011 -0.0134013066
## 2022-12-30  0.062884511  0.0409553533 -0.029971200  0.0159619966 -0.0295426320
## 2023-01-31  0.111692437 -0.0039542705  0.050130255 -0.0562265148 -0.0602297976
## 2023-02-28 -0.055254661  0.0942189584  0.023932502 -0.0344393499 -0.0476950279
## 2023-03-31  0.052574983 -0.0398795149 -0.095373141  0.0778034176 -0.0035081141
## 2023-04-28 -0.026957068  0.0976671205  0.066892599  0.0566665616  0.0404334225
## 2023-05-31 -0.005236638  0.1156657772 -0.018470996 -0.0929469542 -0.0099047798
## 2023-06-30  0.026197375 -0.0396426932  0.069243291  0.0628266008 -0.0095416555
## 2023-07-31  0.123219608 -0.0033255687  0.089422374  0.0358897118  0.0521490798
## 2023-08-31 -0.064055799  0.0983897976 -0.076477483 -0.0126194453 -0.0606320656
## 2023-09-29 -0.155952689 -0.0938060017 -0.008992714 -0.0565105065  0.0602029320
## 2023-10-31 -0.025681651  0.0009201065 -0.034614365  0.0344797591  0.0603598147
## 2023-11-30  0.214995666  0.1433742535  0.115463163  0.0229955900  0.0319907146
## 2023-12-29  0.118075598  0.2342454387  0.086017828 -0.0465326618 -0.0457037678
## 2024-01-31 -0.211169233 -0.0558548222  0.030882974  0.0761344936 -0.0283776815
## 2024-02-29 -0.035301149 -0.0241936152  0.064947066  0.0113895210 -0.0360911436
## 2024-03-28 -0.054108105  0.0066500962  0.073747059  0.0206116207  0.0061604430
## 2024-04-30 -0.139627280 -0.0238153980 -0.037859708  0.0122744974 -0.0224866309
## 2024-05-31  0.056579016  0.1720184418  0.055241341  0.0081771663  0.0238399733
## 2024-06-28  0.024471462  0.1007220697 -0.001827671  0.0023068904  0.0318871025
## 2024-07-31  0.046115423  0.0550545671  0.056324587 -0.0195516753  0.1234266385
## 2024-08-30 -0.092617063  0.1582774883  0.054858353  0.0649039432  0.0240761096
## 2024-09-30 -0.133416360 -0.0195583497 -0.064016743  0.0096305323 -0.0058570874
## 2024-10-31 -0.018118935 -0.1557955294  0.057231870 -0.0415489642 -0.0351242929
## 2024-11-18 -0.037114585  0.0728752826  0.099063699  0.0331647544  0.0435887984
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)

covariance_matrix
##                BA         COKE          JPM           PG          UNH
## BA   0.0117416409 0.0021475424 0.0035684232 0.0007195415 0.0011417156
## COKE 0.0021475424 0.0114937453 0.0018503566 0.0009500483 0.0011928722
## JPM  0.0035684232 0.0018503566 0.0045870639 0.0006144491 0.0012285606
## PG   0.0007195415 0.0009500483 0.0006144491 0.0019876598 0.0005637504
## UNH  0.0011417156 0.0011928722 0.0012285606 0.0005637504 0.0029619176
# 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.20, 0.20, 0.30, 0.2, 0.1)

sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio
##            [,1]
## [1,] 0.05167574
# 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
##              BA       COKE       JPM          PG         UNH
## [1,] 0.01589312 0.01390463 0.0157073 0.003762538 0.002408147
rowSums(component_contribution)
## [1] 0.05167574
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
    round(3) %>%
    as_tibble()

component_percentages
## # A tibble: 1 × 5
##      BA  COKE   JPM    PG   UNH
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.308 0.269 0.304 0.073 0.047
component_percentages %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 BA           0.308
## 2 COKE         0.269
## 3 JPM          0.304
## 4 PG           0.073
## 5 UNH          0.047
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


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

    component_percentages %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
    
    return(component_percentages)
}

6 Plot: Colum Chart of Component Contribution and Weight

plot_data <- asset_returns_wide_tbl %>% calculate_component_contribution(w = c(0.20, 0.20, 0.30, 0.2, 0.1)) %>%
    
    # transform to long form
    pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contributions")

plot_data %>%
    
    ggplot(aes(x = Asset, y = Contributions)) +
    geom_col(fill = "steelblue") +
    
    scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
    theme(plot.title = element_text(hjust = .5)) +
    labs(title = "Percent Contribution to Portfolio Standerd Deveiation")

plot_data <- asset_returns_wide_tbl %>% calculate_component_contribution(w = c(0.20, 0.20, 0.30, 0.2, 0.1)) %>%
    
    # transform to long form
    pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contributions") %>%
    
    # add wights
    add_column(weight = c(0.20, 0.20, 0.30, 0.2, 0.1)) %>%
    
    # transform to long
    pivot_longer(cols = c(Contributions, 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 = .5)) +
    theme_tq() +
    labs(title = "Percent Contribution to Portfolio volitlity 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?

The biggest contributor of risk to portfolio is BA as it has the greatest risk to weight ratio as well as while having the same risk as JPM, but 2/3 the weight. I think my portfolio risk is spread out pretty evenly with a few stocks providing low volatility while BA and COKE have more risk.