# 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

symbols <- c("AMZN", "AAPL", "NFLX", "BA", "DELL")

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

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           BA         DELL          NFLX
## 2013-01-31 -1.555893e-01  0.0566799395 -0.019969830           NA  0.5792178072
## 2013-02-28 -2.561083e-02 -0.0046435024  0.046601883           NA  0.1294683790
## 2013-03-28  2.850402e-03  0.0083654162  0.110095792           NA  0.0063600708
## 2013-04-30  2.709332e-04 -0.0487507497  0.062753170           NA  0.1323750202
## 2013-05-31  2.217165e-02  0.0588686246  0.085096687           NA  0.0460381788
## 2013-06-28 -1.258955e-01  0.0310507506  0.033955536           NA -0.0693560587
## 2013-07-31  1.321023e-01  0.0813355350  0.025634823           NA  0.1468488828
## 2013-08-30  8.044237e-02 -0.0695574090 -0.006749528           NA  0.1495238153
## 2013-09-30 -2.172337e-02  0.1067688897  0.122817029           NA  0.0853633452
## 2013-10-31  9.201556e-02  0.1521839116  0.104934789           NA  0.0420204523
## 2013-11-29  6.770805e-02  0.0781496860  0.031968323           NA  0.1260456325
## 2013-12-31  8.862584e-03  0.0130490386  0.016547707           NA  0.0064580908
## 2014-01-31 -1.139499e-01 -0.1059765119 -0.085859773           NA  0.1059769064
## 2014-02-28  5.591897e-02  0.0094619003  0.034424612           NA  0.0849673396
## 2014-03-31  1.975581e-02 -0.0737086161 -0.026966000           NA -0.2357726219
## 2014-04-30  9.476120e-02 -0.1007565303  0.027741544           NA -0.0890406532
## 2014-05-30  7.576537e-02  0.0273091844  0.052752834           NA  0.2603988640
## 2014-06-30  2.728629e-02  0.0383836202 -0.061128628           NA  0.0530627854
## 2014-07-31  2.832613e-02 -0.0369768154 -0.054512549           NA -0.0414273713
## 2014-08-29  7.465163e-02  0.0799468404  0.057165069           NA  0.1221472352
## 2014-09-30 -1.722044e-02 -0.0502010184  0.004563727           NA -0.0569909207
## 2014-10-31  6.948904e-02 -0.0540982347 -0.019581154           NA -0.1386421470
## 2014-11-28  1.007306e-01  0.1031187277  0.078746995           NA -0.1250817171
## 2014-12-31 -7.460608e-02 -0.0872368614 -0.033142052           NA -0.0144727330
## 2015-01-30  5.961165e-02  0.1330922557  0.111901545           NA  0.2571875124
## 2015-02-27  9.601571e-02  0.0697992426  0.043169769           NA  0.0722680160
## 2015-03-31 -3.187407e-02 -0.0214295755 -0.005117501           NA -0.1307827695
## 2015-04-30  5.769542e-03  0.1253212736 -0.045949252           NA  0.2893246523
## 2015-05-29  4.434149e-02  0.0175090293 -0.013481424           NA  0.1145793430
## 2015-06-30 -3.793824e-02  0.0112589814 -0.012892177           NA  0.0513461801
## 2015-07-31 -3.348106e-02  0.2111621090  0.038535343           NA  0.1972314899
## 2015-08-31 -6.848894e-02 -0.0443525782 -0.091881611           NA  0.0062789186
## 2015-09-30 -2.205760e-02 -0.0019516837  0.002063892           NA -0.1079428532
## 2015-10-30  8.011219e-02  0.2010808743  0.122869949           NA  0.0483934447
## 2015-11-30 -5.820993e-03  0.0602956777 -0.011688963           NA  0.1292201596
## 2015-12-31 -1.167905e-01  0.0165440008 -0.005930421           NA -0.0753374900
## 2016-01-29 -7.822325e-02 -0.1410054620 -0.185327579           NA -0.2194783218
## 2016-02-29 -1.288447e-03 -0.0605352209 -0.007154645           NA  0.0169505524
## 2016-03-31  1.197461e-01  0.0717834363  0.071505803           NA  0.0902267645
## 2016-04-29 -1.507313e-01  0.1053453760  0.060077849           NA -0.1270822750
## 2016-05-31  6.931429e-02  0.0915002899 -0.058196865           NA  0.1304025548
## 2016-06-30 -4.359630e-02 -0.0099694639  0.029062111           NA -0.1144250835
## 2016-07-29  8.623507e-02  0.0586021229  0.028765322           NA -0.0025174134
## 2016-08-31  2.337651e-02  0.0135476418 -0.023751751           NA  0.0657364022
## 2016-09-30  6.344843e-02  0.0848953908  0.017535781  0.067499737  0.0112246699
## 2016-10-31  4.324994e-03 -0.0583893058  0.078020206  0.026629576  0.2367091536
## 2016-11-30 -2.183759e-02 -0.0509721927  0.063161110  0.087147156 -0.0650992833
## 2016-12-30  4.684058e-02 -0.0009330556  0.033440981  0.025985144  0.0564934501
## 2017-01-31  4.664184e-02  0.0936394059  0.048520940  0.136188404  0.1280336976
## 2017-02-28  1.255556e-01  0.0258446800  0.106475246  0.007906420  0.0100410836
## 2017-03-31  4.754066e-02  0.0479423007 -0.018875188  0.009249837  0.0391854826
## 2017-04-28 -6.952323e-05  0.0424566944  0.044077947  0.046200694  0.0292677767
## 2017-05-31  6.560730e-02  0.0725778018  0.022661861  0.033409963  0.0689841760
## 2017-06-30 -5.891556e-02 -0.0271286156  0.052531488 -0.127067279 -0.0874853720
## 2017-07-31  3.218055e-02  0.0202278808  0.203833152  0.050417301  0.1954425989
## 2017-08-31  1.016526e-01 -0.0072953953 -0.005668811  0.153461341 -0.0390093333
## 2017-09-29 -6.213436e-02 -0.0198260355  0.058939365  0.029974779  0.0373014045
## 2017-10-31  9.240367e-02  0.1395154056  0.014721451  0.069536497  0.0798771971
## 2017-11-30  2.007507e-02  0.0626577318  0.075774472 -0.056284575 -0.0461006656
## 2017-12-29 -1.536335e-02 -0.0062057845  0.063374990  0.038118988  0.0230816211
## 2018-01-31 -1.069328e-02  0.2156265497  0.183671410 -0.125409241  0.3422453562
## 2018-02-28  6.596091e-02  0.0415536279  0.026806630  0.035485625  0.0750958659
## 2018-03-29 -5.980391e-02 -0.0440034760 -0.099576390 -0.014644279  0.0135328404
## 2018-04-30 -1.513353e-02  0.0788803060  0.017175001 -0.019865561  0.0563153192
## 2018-05-31  1.267418e-01  0.0397392430  0.059238974  0.116776225  0.1180177495
## 2018-06-29 -9.462754e-03  0.0421636787 -0.048433780  0.047455185  0.1073124981
## 2018-07-31  2.759880e-02  0.0446635734  0.060121250  0.089726831 -0.1483892939
## 2018-08-31  1.826733e-01  0.1243079079 -0.033726040  0.038692682  0.0857955874
## 2018-09-28 -8.337769e-03 -0.0048359814  0.081506964  0.009829797  0.0173903689
## 2018-10-31 -3.095146e-02 -0.2258869989 -0.046901547 -0.071813606 -0.2149050726
## 2018-11-30 -1.999127e-01  0.0560700324 -0.018483264  0.154387724 -0.0532520010
## 2018-12-31 -1.240885e-01 -0.1180514843 -0.072529851 -0.178243301 -0.0667287380
## 2019-01-31  5.368684e-02  0.1348080312  0.178749274 -0.005745745  0.2377564149
## 2019-02-28  4.380296e-02 -0.0469930640  0.136842655  0.138714313  0.0533383470
## 2019-03-29  9.260262e-02  0.0824420184 -0.142782634  0.050137133 -0.0043097723
## 2019-04-30  5.490088e-02  0.0786806224 -0.009827463  0.138524184  0.0384589024
## 2019-05-31 -1.326322e-01 -0.0818753491 -0.094675438 -0.123977142 -0.0764149871
## 2019-06-28  1.226771e-01  0.0646557767  0.063511708 -0.158919958  0.0676869856
## 2019-07-31  7.361695e-02 -0.0142806686 -0.064771221  0.128053767 -0.1286120899
## 2019-08-30 -1.659804e-02 -0.0496880810  0.071211574 -0.113786151 -0.0948922673
## 2019-09-30  7.042259e-02 -0.0229951159  0.044006196  0.006383656 -0.0931610198
## 2019-10-31  1.049765e-01  0.0232034080 -0.112726399  0.019666533  0.0713417349
## 2019-11-29  7.469350e-02  0.0134958216  0.080262991 -0.086856597  0.0905829220
## 2019-12-31  9.420438e-02  0.0257863501 -0.116964019  0.058085989  0.0279227940
## 2020-01-31  5.260185e-02  0.0834803026 -0.023260958 -0.052328346  0.0643897455
## 2020-02-28 -1.218305e-01 -0.0642332026 -0.139796995 -0.186801501  0.0670726963
## 2020-03-31 -7.231422e-02  0.0344213022 -0.612285506 -0.022748102  0.0173805330
## 2020-04-30  1.444240e-01  0.2381504762 -0.055983703  0.076398933  0.1116390480
## 2020-05-29  8.166640e-02 -0.0128673719  0.033676984  0.150832320 -0.0002858456
## 2020-06-30  1.374868e-01  0.1218341331  0.228545433  0.101444736  0.0807736724
## 2020-07-31  1.528341e-01  0.1372488933 -0.148529138  0.085265587  0.0717317246
## 2020-08-31  1.960349e-01  0.0866005735  0.083852427  0.099358961  0.0799293979
## 2020-09-30 -1.081715e-01 -0.0916533253 -0.038927502  0.024072180 -0.0573783743
## 2020-10-30 -6.188827e-02 -0.0364089187 -0.135001990 -0.116269898 -0.0497966282
## 2020-11-30  9.120467e-02  0.0425228214  0.377964845  0.135872540  0.0309615020
## 2020-12-31  1.084721e-01  0.0276719582  0.015773526  0.059882914  0.0970870744
## 2021-01-29 -5.516956e-03 -0.0156985929 -0.097419264 -0.005472559 -0.0155437114
## 2021-02-26 -8.306843e-02 -0.0359675607  0.087796344  0.106361702  0.0120608627
## 2021-03-31  7.312631e-03  0.0003717151  0.183531490  0.083726855 -0.0324212105
## 2021-04-30  7.345310e-02  0.1139202399 -0.083519893  0.109289209 -0.0158244352
## 2021-05-28 -5.181688e-02 -0.0730764715  0.052824308  0.003147651 -0.0209791877
## 2021-06-30  9.450011e-02  0.0651836137 -0.030665425  0.010387925  0.0492816132
## 2021-07-30  6.295826e-02 -0.0332696301 -0.056147275 -0.031078935 -0.0203491777
## 2021-08-31  4.161130e-02  0.0421339363 -0.031304389  0.008656239  0.0950695060
## 2021-09-30 -7.046155e-02 -0.0550034409  0.002002560  0.065333373  0.0698019211
## 2021-10-29  5.700126e-02  0.0262547651 -0.060491089  0.055613974  0.1231245456
## 2021-11-30  9.991921e-02  0.0391473463 -0.045354506  0.012875439 -0.0727082022
## 2021-12-31  7.160302e-02 -0.0505062029  0.017386520 -0.005326746 -0.0634444870
## 2022-01-31 -1.583690e-02 -0.1085098142 -0.005379044  0.011329602 -0.3438762168
## 2022-02-28 -5.558235e-02  0.0263230079  0.025150449 -0.108671331 -0.0794420544
## 2022-03-31  5.588256e-02  0.0596239190 -0.069779315 -0.015225197 -0.0518377235
## 2022-04-29 -1.021777e-01 -0.2711856801 -0.252015930 -0.058475178 -0.6769150653
## 2022-05-31 -5.603722e-02 -0.0333130879 -0.124625819  0.060461950  0.0365177336
## 2022-06-30 -8.493678e-02 -0.1238178226  0.039688988 -0.077625976 -0.1213919403
## 2022-07-29  1.728044e-01  0.2394860591  0.152916927 -0.017479224  0.2516130190
## 2022-08-31 -3.170528e-02 -0.0625299224  0.005883122 -0.162806321 -0.0059760083
## 2022-09-30 -1.289443e-01 -0.1149865758 -0.280283597 -0.113840587  0.0517762908
## 2022-10-31  1.039558e-01 -0.0981105335  0.162960635  0.126329072  0.2148866613
## 2022-11-30 -3.358517e-02 -0.0593198454  0.227303083  0.153927475  0.0457051938
## 2022-12-30 -1.304192e-01 -0.1391406409  0.062884511 -0.107620541 -0.0354794590
## 2023-01-31  1.048294e-01  0.2051735029  0.111692437  0.017969579  0.1823328028
## 2023-02-28  2.291831e-02 -0.0902516639 -0.055254661  0.000492308 -0.0939461074
## 2023-03-31  1.121214e-01  0.0918019370  0.052574983 -0.010636989  0.0699795803
## 2023-04-28  2.857491e-02  0.0206963031 -0.026957068  0.087035031 -0.0460542977
## 2023-05-31  4.502921e-02  0.1340765703 -0.005236638  0.029900224  0.1805874132
## 2023-06-30  9.014237e-02  0.0779864104  0.026197375  0.188587727  0.1084198198
## 2023-07-31  1.270444e-02  0.0251489708  0.123219608 -0.015305698 -0.0034566451
## 2023-08-31 -4.330830e-02  0.0318772770 -0.064055799  0.060847018 -0.0121241583
## 2023-09-29 -9.285922e-02 -0.0821945627 -0.155952689  0.203027861 -0.1384714676
## 2023-10-31 -2.573323e-03  0.0458940197 -0.025681651 -0.023678152  0.0864351944
## 2023-11-30  1.077598e-01  0.0931972815  0.214995666  0.125672974  0.1408733862
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)

covariance_matrix
##             AAPL        AMZN          BA DELL        NFLX
## AAPL 0.006409116 0.003574357 0.002640537   NA 0.002946398
## AMZN 0.003574357 0.007560841 0.002739862   NA 0.006728813
## BA   0.002640537 0.002739862 0.011868821   NA 0.004294980
## DELL          NA          NA          NA   NA          NA
## NFLX 0.002946398 0.006728813 0.004294980   NA 0.018318262
# 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,]   NA
# 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 BA DELL NFLX
## [1,]   NA   NA NA   NA   NA
rowSums(component_contribution)
## [1] NA
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
    round(3) %>%
    as_tibble()

component_percentages
## # A tibble: 1 × 5
##    AAPL  AMZN    BA  DELL  NFLX
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    NA    NA    NA    NA    NA
component_percentages %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 AAPL            NA
## 2 AMZN            NA
## 3 BA              NA
## 4 DELL            NA
## 5 NFLX            NA

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    BA  DELL  NFLX
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    NA    NA    NA    NA    NA

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    BA  DELL  NFLX
##   <date>     <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30    NA    NA    NA    NA    NA
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    BA  DELL  NFLX
##   <date>     <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27    NA    NA    NA    NA    NA
dump(list = c("calculate_component_contribution",
              "calculate_comp_contrib_by_window"),
     file = "../00_scripts/calculate_comp_contrib_to_portfolio_volatility.R")
# 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: 107 × 6
##    date        AAPL  AMZN    BA  DELL  NFLX
##    <date>     <dbl> <dbl> <dbl> <dbl> <dbl>
##  1 2015-01-30    NA    NA    NA    NA    NA
##  2 2015-02-27    NA    NA    NA    NA    NA
##  3 2015-03-31    NA    NA    NA    NA    NA
##  4 2015-04-30    NA    NA    NA    NA    NA
##  5 2015-05-29    NA    NA    NA    NA    NA
##  6 2015-06-30    NA    NA    NA    NA    NA
##  7 2015-07-31    NA    NA    NA    NA    NA
##  8 2015-08-31    NA    NA    NA    NA    NA
##  9 2015-09-30    NA    NA    NA    NA    NA
## 10 2015-10-30    NA    NA    NA    NA    NA
## # ℹ 97 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."))

In my portfolio the largest contributors to volatility are AAPL and AMZN with 25 percent compared to the 20 Percent from BA and DELL close behind. I do not think my portfolios risk is concreted on one asset where four out of the five have fairly close volatility where none are extremly risky but do have have a risk factor like any stock you invest in.