Apply it to your data 12

Goal
1 Import stock prices
2 Convert prices to returns
3 Component Contribution Step-by-Step
4 Component Contribution with a Custom Function
5 Visualizing Component Contribution
6 Plot: Colum Chart of Component Contribution and Weight

# 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("AAPL", "MSFT", "TSLA", "NVDA", "AMZN")

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

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         MSFT         NVDA         TSLA
## 2016-01-29 -7.822335e-02 -0.1410054620 -0.007054225 -0.118048665 -0.227360626
## 2016-02-29 -1.288332e-03 -0.0605352209 -0.072343939  0.071923621  0.003810669
## 2016-03-31  1.197461e-01  0.0717834363  0.082036262  0.127655081  0.179948109
## 2016-04-29 -1.507313e-01  0.1053453760 -0.102086431 -0.002810798  0.046721797
## 2016-05-31  6.931441e-02  0.0915002899  0.067841971  0.276388479 -0.075597968
## 2016-06-30 -4.359655e-02 -0.0099694639 -0.035138331  0.006187875 -0.050296440
## 2016-07-29  8.623507e-02  0.0586021229  0.102267891  0.194444021  0.100785334
## 2016-08-31  2.337673e-02  0.0135476418  0.019881339  0.073469012 -0.102058091
## 2016-09-30  6.344820e-02  0.0848953908  0.002433316  0.110693518 -0.038366372
## 2016-10-31  4.324960e-03 -0.0583893058  0.039487628  0.037805126 -0.031364583
## 2016-11-30 -2.183748e-02 -0.0509721927  0.012391098  0.260525388 -0.043041267
## 2016-12-30  4.684080e-02 -0.0009330556  0.030721439  0.146435700  0.120665178
## 2017-01-31  4.664144e-02  0.0936394059  0.039598295  0.022601913  0.164624916
## 2017-02-28  1.255548e-01  0.0258446800 -0.004373436 -0.071874933 -0.007730364
## 2017-03-31  4.754226e-02  0.0479423007  0.028960652  0.070843798  0.107278727
## 2017-04-28 -7.005756e-05  0.0424566944  0.038718187 -0.043434141  0.120916212
## 2017-05-31  6.560722e-02  0.0725778018  0.025673017  0.326022191  0.082295892
## 2017-06-30 -5.891534e-02 -0.0271286156 -0.013115224  0.001453854  0.058654468
## 2017-07-31  3.218021e-02  0.0202278808  0.053249710  0.117044881 -0.111459860
## 2017-08-31  1.016533e-01 -0.0072953953  0.033389173  0.042639458  0.095543446
## 2017-09-29 -6.213494e-02 -0.0198260355 -0.003752007  0.053601239 -0.042474144
## 2017-10-31  9.240374e-02  0.1395154056  0.110342336  0.145700399 -0.028457409
## 2017-11-30  2.007517e-02  0.0626577318  0.016841182 -0.029244759 -0.070862541
## 2017-12-29 -1.536330e-02 -0.0062057845  0.016145545 -0.036584017  0.008061928
## 2018-01-31 -1.069346e-02  0.2156265497  0.104997815  0.239240951  0.129254571
## 2018-02-28  6.596106e-02  0.0415536279 -0.008450420 -0.014959145 -0.032266877
## 2018-03-29 -5.980405e-02 -0.0440034760 -0.027022674 -0.043969170 -0.253920408
## 2018-04-30 -1.513345e-02  0.0788803060  0.024352810 -0.029312615  0.099254576
## 2018-05-31  1.267415e-01  0.0397392430  0.059651988  0.115144978 -0.031698139
## 2018-06-29 -9.462592e-03  0.0421636787 -0.002329624 -0.062544829  0.186043257
## 2018-07-31  2.759888e-02  0.0446635734  0.073020929  0.033048620 -0.140021491
## 2018-08-31  1.826731e-01  0.1243079079  0.061088252  0.137075573  0.011737389
## 2018-09-28 -8.337365e-03 -0.0048359814  0.017997837  0.001210420 -0.130439038
## 2018-10-31 -3.095172e-02 -0.2258869989 -0.068387283 -0.287373676  0.242170576
## 2018-11-30 -1.999125e-01  0.0560700324  0.041797798 -0.253667191  0.038271580
## 2018-12-31 -1.240884e-01 -0.1180514843 -0.087790402 -0.202283538 -0.051761952
## 2019-01-31  5.368644e-02  0.1348080312  0.027768992  0.073974378 -0.080628789
## 2019-02-28  4.380321e-02 -0.0469930640  0.074511211  0.071593931  0.041032981
## 2019-03-29  9.260259e-02  0.0824420184  0.051409413  0.151869619 -0.133656413
## 2019-04-30  5.490097e-02  0.0786806224  0.101963209  0.007988056 -0.159123803
## 2019-05-31 -1.326324e-01 -0.0818753491 -0.050746941 -0.288680120 -0.253945372
## 2019-06-28  1.226772e-01  0.0646557767  0.079843932  0.192591729  0.188012109
## 2019-07-31  7.361715e-02 -0.0142806686  0.017096697  0.026972161  0.078092373
## 2019-08-30 -1.659836e-02 -0.0496880810  0.014925102 -0.006207871 -0.068516948
## 2019-09-30  7.042249e-02 -0.0229951159  0.008450838  0.038414436  0.065449565
## 2019-10-31  1.049766e-01  0.0232034080  0.030739009  0.143947290  0.268061253
## 2019-11-29  7.469372e-02  0.0134958216  0.057761299  0.076031240  0.046592176
## 2019-12-31  9.420392e-02  0.0257863501  0.040901363  0.082163178  0.237359743
## 2020-01-31  5.260182e-02  0.0834803026  0.076456135  0.004790910  0.441578342
## 2020-02-28 -1.218299e-01 -0.0642332026 -0.046765159  0.133626804  0.026424253
## 2020-03-31 -7.231452e-02  0.0344213022 -0.026899936 -0.024248258 -0.242781458
## 2020-04-30  1.444235e-01  0.2381504762  0.127800464  0.103279272  0.400209535
## 2020-05-29  8.166706e-02 -0.0128673719  0.025074346  0.194461999  0.065730500
## 2020-06-30  1.374866e-01  0.1218341331  0.104863699  0.068216794  0.257108657
## 2020-07-31  1.528341e-01  0.1372488933  0.007343564  0.111189352  0.281420674
## 2020-08-31  1.960348e-01  0.0866005735  0.097808935  0.231105295  0.554719320
## 2020-09-30 -1.081715e-01 -0.0916533253 -0.069775351  0.011895466 -0.149762306
## 2020-10-30 -6.188810e-02 -0.0364089187 -0.038086123 -0.076501319 -0.100371771
## 2020-11-30  9.120450e-02  0.0425228214  0.058325949  0.066921580  0.380308519
## 2020-12-30  1.162047e-01  0.0365122897  0.034931828 -0.018972663  0.202178340

# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)

covariance_matrix

##             AAPL        AMZN        MSFT        NVDA        TSLA
## AAPL 0.007410183 0.003523565 0.003006250 0.006170658 0.007527757
## AMZN 0.003523565 0.006518834 0.002710169 0.004942624 0.004904584
## MSFT 0.003006250 0.002710169 0.002686678 0.003346346 0.003483167
## NVDA 0.006170658 0.004942624 0.003346346 0.015455483 0.005281701
## TSLA 0.007527757 0.004904584 0.003483167 0.005281701 0.029181874

# 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.07246657

# 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        MSFT       NVDA       TSLA
## [1,] 0.01835879 0.01563347 0.008235594 0.01950377 0.01073494

rowSums(component_contribution)

## [1] 0.07246657

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

component_percentages

## # A tibble: 1 × 5
##    AAPL  AMZN  MSFT  NVDA  TSLA
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.253 0.216 0.114 0.269 0.148

component_percentages %>%

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

## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 AAPL         0.253
## 2 AMZN         0.216
## 3 MSFT         0.114
## 4 NVDA         0.269
## 5 TSLA         0.148

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

asset_returns_wide_tbl

##                     AAPL          AMZN         MSFT         NVDA         TSLA
## 2016-01-29 -7.822335e-02 -0.1410054620 -0.007054225 -0.118048665 -0.227360626
## 2016-02-29 -1.288332e-03 -0.0605352209 -0.072343939  0.071923621  0.003810669
## 2016-03-31  1.197461e-01  0.0717834363  0.082036262  0.127655081  0.179948109
## 2016-04-29 -1.507313e-01  0.1053453760 -0.102086431 -0.002810798  0.046721797
## 2016-05-31  6.931441e-02  0.0915002899  0.067841971  0.276388479 -0.075597968
## 2016-06-30 -4.359655e-02 -0.0099694639 -0.035138331  0.006187875 -0.050296440
## 2016-07-29  8.623507e-02  0.0586021229  0.102267891  0.194444021  0.100785334
## 2016-08-31  2.337673e-02  0.0135476418  0.019881339  0.073469012 -0.102058091
## 2016-09-30  6.344820e-02  0.0848953908  0.002433316  0.110693518 -0.038366372
## 2016-10-31  4.324960e-03 -0.0583893058  0.039487628  0.037805126 -0.031364583
## 2016-11-30 -2.183748e-02 -0.0509721927  0.012391098  0.260525388 -0.043041267
## 2016-12-30  4.684080e-02 -0.0009330556  0.030721439  0.146435700  0.120665178
## 2017-01-31  4.664144e-02  0.0936394059  0.039598295  0.022601913  0.164624916
## 2017-02-28  1.255548e-01  0.0258446800 -0.004373436 -0.071874933 -0.007730364
## 2017-03-31  4.754226e-02  0.0479423007  0.028960652  0.070843798  0.107278727
## 2017-04-28 -7.005756e-05  0.0424566944  0.038718187 -0.043434141  0.120916212
## 2017-05-31  6.560722e-02  0.0725778018  0.025673017  0.326022191  0.082295892
## 2017-06-30 -5.891534e-02 -0.0271286156 -0.013115224  0.001453854  0.058654468
## 2017-07-31  3.218021e-02  0.0202278808  0.053249710  0.117044881 -0.111459860
## 2017-08-31  1.016533e-01 -0.0072953953  0.033389173  0.042639458  0.095543446
## 2017-09-29 -6.213494e-02 -0.0198260355 -0.003752007  0.053601239 -0.042474144
## 2017-10-31  9.240374e-02  0.1395154056  0.110342336  0.145700399 -0.028457409
## 2017-11-30  2.007517e-02  0.0626577318  0.016841182 -0.029244759 -0.070862541
## 2017-12-29 -1.536330e-02 -0.0062057845  0.016145545 -0.036584017  0.008061928
## 2018-01-31 -1.069346e-02  0.2156265497  0.104997815  0.239240951  0.129254571
## 2018-02-28  6.596106e-02  0.0415536279 -0.008450420 -0.014959145 -0.032266877
## 2018-03-29 -5.980405e-02 -0.0440034760 -0.027022674 -0.043969170 -0.253920408
## 2018-04-30 -1.513345e-02  0.0788803060  0.024352810 -0.029312615  0.099254576
## 2018-05-31  1.267415e-01  0.0397392430  0.059651988  0.115144978 -0.031698139
## 2018-06-29 -9.462592e-03  0.0421636787 -0.002329624 -0.062544829  0.186043257
## 2018-07-31  2.759888e-02  0.0446635734  0.073020929  0.033048620 -0.140021491
## 2018-08-31  1.826731e-01  0.1243079079  0.061088252  0.137075573  0.011737389
## 2018-09-28 -8.337365e-03 -0.0048359814  0.017997837  0.001210420 -0.130439038
## 2018-10-31 -3.095172e-02 -0.2258869989 -0.068387283 -0.287373676  0.242170576
## 2018-11-30 -1.999125e-01  0.0560700324  0.041797798 -0.253667191  0.038271580
## 2018-12-31 -1.240884e-01 -0.1180514843 -0.087790402 -0.202283538 -0.051761952
## 2019-01-31  5.368644e-02  0.1348080312  0.027768992  0.073974378 -0.080628789
## 2019-02-28  4.380321e-02 -0.0469930640  0.074511211  0.071593931  0.041032981
## 2019-03-29  9.260259e-02  0.0824420184  0.051409413  0.151869619 -0.133656413
## 2019-04-30  5.490097e-02  0.0786806224  0.101963209  0.007988056 -0.159123803
## 2019-05-31 -1.326324e-01 -0.0818753491 -0.050746941 -0.288680120 -0.253945372
## 2019-06-28  1.226772e-01  0.0646557767  0.079843932  0.192591729  0.188012109
## 2019-07-31  7.361715e-02 -0.0142806686  0.017096697  0.026972161  0.078092373
## 2019-08-30 -1.659836e-02 -0.0496880810  0.014925102 -0.006207871 -0.068516948
## 2019-09-30  7.042249e-02 -0.0229951159  0.008450838  0.038414436  0.065449565
## 2019-10-31  1.049766e-01  0.0232034080  0.030739009  0.143947290  0.268061253
## 2019-11-29  7.469372e-02  0.0134958216  0.057761299  0.076031240  0.046592176
## 2019-12-31  9.420392e-02  0.0257863501  0.040901363  0.082163178  0.237359743
## 2020-01-31  5.260182e-02  0.0834803026  0.076456135  0.004790910  0.441578342
## 2020-02-28 -1.218299e-01 -0.0642332026 -0.046765159  0.133626804  0.026424253
## 2020-03-31 -7.231452e-02  0.0344213022 -0.026899936 -0.024248258 -0.242781458
## 2020-04-30  1.444235e-01  0.2381504762  0.127800464  0.103279272  0.400209535
## 2020-05-29  8.166706e-02 -0.0128673719  0.025074346  0.194461999  0.065730500
## 2020-06-30  1.374866e-01  0.1218341331  0.104863699  0.068216794  0.257108657
## 2020-07-31  1.528341e-01  0.1372488933  0.007343564  0.111189352  0.281420674
## 2020-08-31  1.960348e-01  0.0866005735  0.097808935  0.231105295  0.554719320
## 2020-09-30 -1.081715e-01 -0.0916533253 -0.069775351  0.011895466 -0.149762306
## 2020-10-30 -6.188810e-02 -0.0364089187 -0.038086123 -0.076501319 -0.100371771
## 2020-11-30  9.120450e-02  0.0425228214  0.058325949  0.066921580  0.380308519
## 2020-12-30  1.162047e-01  0.0365122897  0.034931828 -0.018972663  0.202178340

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
##    AAPL  AMZN  MSFT  NVDA  TSLA
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.253 0.216 0.114 0.269 0.148

5 Visualizing Component Contribution

Column Chart of Component Contribution

plot_data <- asset_returns_wide_tbl %>%
    
    calculate_component_contribution(w = c(.25, .25, .2, .2, .1)) %>%
    
    # Transform to long form
    pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution")

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

6 Plot: Colum Chart of Component Contribution and Weight

Column Chart of Component Contribution and Weight

plot_data <- asset_returns_wide_tbl %>%
    
    calculate_component_contribution(w = c(.25, .25, .2, .2, .1)) %>%
    
    # Transform to long form
    pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>%
    
    # Add weights
    add_column(weight = c(.25, .25, .2, .2, .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?

For the most part the leading factor is NVDA when it comes to contribution but the real weight is swaying more towards AAPL when compared to NVDA for that top spot. So it is certainly between those two. As for if I believe the risk is concentrated and I would say no for this portfolio as a number of the stocks hold a relatively equal weight.