# Load packages

# Core
library(tidyverse)
library(tidyquant)
library(readr)

# Time series
library(lubridate)
library(tibbletime)

# modeling
library(broom)

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

prices <- tq_get(x    = symbols, 
                 get. = "stock.prices",
                 from = "2012-12-31", 
                 to   = "2017-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 
##                     AAPL          AMZN         NVDA            PG         TSLA
## 2013-01-31 -1.555891e-01  0.0566799395  0.000000000  0.1098050678  0.102078114
## 2013-02-28 -2.561089e-02 -0.0046435024  0.038221915  0.0134795658 -0.074128640
## 2013-03-28  2.850330e-03  0.0083654162  0.013338901  0.0114854138  0.084208138
## 2013-04-30  2.708784e-04 -0.0487507497  0.070705976  0.0035495997  0.354111531
## 2013-05-31  2.217166e-02  0.0588686246  0.054652026 -0.0001300024  0.593716684
## 2013-06-28 -1.258954e-01  0.0310507506 -0.030167145  0.0029917848  0.093672163
## 2013-07-31  1.321024e-01  0.0813355350  0.028091490  0.0495566813  0.223739522
## 2013-08-30  8.044258e-02 -0.0695574090  0.026270537 -0.0304718706  0.229971642
## 2013-09-30 -2.172368e-02  0.1067688897  0.053460223 -0.0299738826  0.134706620
## 2013-10-31  9.201566e-02  0.1521839116 -0.024066382  0.0738224351 -0.189806595
## 2013-11-29  6.770830e-02  0.0781496860  0.032035192  0.0420742660 -0.228409405
## 2013-12-31  8.861779e-03  0.0130490386  0.026566618 -0.0339343415  0.167108541
## 2014-01-31 -1.139489e-01 -0.1059765119 -0.020176938 -0.0531033942  0.187261714
## 2014-02-28  5.591782e-02  0.0094619003  0.162107505  0.0262766937  0.299722785
## 2014-03-31  1.975687e-02 -0.0737086161 -0.025904073  0.0243637322 -0.160783242
## 2014-04-30  9.476062e-02 -0.1007565303  0.030788766  0.0318632007 -0.002690122
## 2014-05-30  7.576580e-02  0.0273091844  0.032886335 -0.0215510362 -0.000577422
## 2014-06-30  2.728599e-02  0.0383836202 -0.024508477 -0.0276084090  0.144457224
## 2014-07-31  2.832597e-02 -0.0369768154 -0.057729555 -0.0083353479 -0.072372676
## 2014-08-29  7.465188e-02  0.0799468404  0.110060098  0.0722122277  0.188794007
## 2014-09-30 -1.722019e-02 -0.0502010184 -0.052782823  0.0075520856 -0.105566477
## 2014-10-31  6.948858e-02 -0.0540982347  0.057399276  0.0489305029 -0.004046477
## 2014-11-28  1.007307e-01  0.1031187277  0.074852212  0.0355689994  0.011599801
## 2014-12-31 -7.460606e-02 -0.0872368614 -0.044863658  0.0072717294 -0.094774519
## 2015-01-30  5.961169e-02  0.1330922557 -0.043318962 -0.0704973224 -0.088365289
## 2015-02-27  9.601577e-02  0.0697992426  0.142699105  0.0099162649 -0.001277808
## 2015-03-31 -3.187401e-02 -0.0214295755 -0.052582725 -0.0381918567 -0.074350051
## 2015-04-30  5.769703e-03  0.1253212736  0.058909118 -0.0220931969  0.180226808
## 2015-05-29  4.434136e-02  0.0175090293  0.001459621 -0.0141865589  0.103899574
## 2015-06-30 -3.793830e-02  0.0112589814 -0.095716905 -0.0019155452  0.067300935
## 2015-07-31 -3.348104e-02  0.2111621090 -0.007988068 -0.0117240380 -0.007896616
## 2015-08-31 -6.848880e-02 -0.0443525782  0.123595412 -0.0818806356 -0.066366250
## 2015-09-30 -2.205776e-02 -0.0019516837  0.092151114  0.0178111113 -0.002653519
## 2015-10-30  8.011232e-02  0.2010808743  0.140555105  0.0688365093 -0.182659777
## 2015-11-30 -5.820991e-03  0.0602956777  0.115405446 -0.0203686934  0.106828586
## 2015-12-31 -1.167903e-01  0.0165440008  0.038347207  0.0592719342  0.041471519
## 2016-01-29 -7.822369e-02 -0.1410054620 -0.118048559  0.0369855637 -0.227360626
## 2016-02-29 -1.288697e-03 -0.0605352209  0.071923725 -0.0172867152  0.003810669
## 2016-03-31  1.197464e-01  0.0717834363  0.127654643  0.0248478003  0.179948109
## 2016-04-29 -1.507310e-01  0.1053453760 -0.002810478 -0.0188090253  0.046721797
## 2016-05-31  6.931445e-02  0.0915002899  0.276388463  0.0114174211 -0.075597968
## 2016-06-30 -4.359658e-02 -0.0099694639  0.006188222  0.0438185167 -0.050296440
## 2016-07-29  8.623527e-02  0.0586021229  0.194443539  0.0186126851  0.100785334
## 2016-08-31  2.337629e-02  0.0135476418  0.073469219  0.0198965857 -0.102058091
## 2016-09-30  6.344851e-02  0.0848953908  0.110693259  0.0275629474 -0.038366372
## 2016-10-31  4.324888e-03 -0.0583893058  0.037805384 -0.0257302441 -0.031364583
## 2016-11-30 -2.183791e-02 -0.0509721927  0.260525274 -0.0512937543 -0.043041267
## 2016-12-30  4.684092e-02 -0.0009330556  0.146435672  0.0194556607  0.120665178
## 2017-01-31  4.664158e-02  0.0936394059  0.022602021  0.0489062377  0.164624916
## 2017-02-28  1.255554e-01  0.0258446800 -0.071874936  0.0388478453 -0.007730364
## 2017-03-31  4.754151e-02  0.0479423007  0.070843655 -0.0134871217  0.107278727
## 2017-04-28 -6.974621e-05  0.0424566944 -0.043434144 -0.0208193552  0.120916212
## 2017-05-31  6.560758e-02  0.0725778018  0.326022441  0.0086647603  0.082295892
## 2017-06-30 -5.891603e-02 -0.0271286156  0.001453401 -0.0107280505  0.058654468
## 2017-07-31  3.218046e-02  0.0202278808  0.117044958  0.0490634381 -0.111459860
## 2017-08-31  1.016530e-01 -0.0072953953  0.042639770  0.0158394028  0.095543446
## 2017-09-29 -6.213511e-02 -0.0198260355  0.053601153 -0.0140790374 -0.042474144
## 2017-10-31  9.240422e-02  0.1395154056  0.145700108 -0.0448811236 -0.028457409
## 2017-11-30  2.007511e-02  0.0626577318 -0.029244614  0.0414054921 -0.070862541
## 2017-12-29 -1.536336e-02 -0.0062057845 -0.036583530  0.0207847911  0.008061928
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)

covariance_matrix
##              AAPL         AMZN          NVDA            PG          TSLA
## AAPL 0.0048301440 0.0015511155  0.0020787919  0.0004545913  0.0004838957
## AMZN 0.0015511155 0.0054660218  0.0015926682  0.0004558329  0.0005128766
## NVDA 0.0020787919 0.0015926682  0.0077584811 -0.0000322077  0.0017607763
## PG   0.0004545913 0.0004558329 -0.0000322077  0.0013822965 -0.0006577558
## TSLA 0.0004838957 0.0005128766  0.0017607763 -0.0006577558  0.0209573536
# 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.2, 0.2, 0.2, 0.2, 0.2)

sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio
##           [,1]
## [1,] 0.0476636
# 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       NVDA          PG      TSLA
## [1,] 0.007887393 0.008038432 0.01104282 0.001345058 0.0193499
rowSums(component_contribution)
## [1] 0.0476636
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
    round(3) %>%
    as_tibble()

component_percentages
## # A tibble: 1 × 5
##    AAPL  AMZN  NVDA    PG  TSLA
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.165 0.169 0.232 0.028 0.406
component_percentages %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 AAPL         0.165
## 2 AMZN         0.169
## 3 NVDA         0.232
## 4 PG           0.028
## 5 TSLA         0.406

6 Plot: Colum Chart of Component Contribution and Weight

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         NVDA            PG         TSLA
## 2013-01-31 -1.555891e-01  0.0566799395  0.000000000  0.1098050678  0.102078114
## 2013-02-28 -2.561089e-02 -0.0046435024  0.038221915  0.0134795658 -0.074128640
## 2013-03-28  2.850330e-03  0.0083654162  0.013338901  0.0114854138  0.084208138
## 2013-04-30  2.708784e-04 -0.0487507497  0.070705976  0.0035495997  0.354111531
## 2013-05-31  2.217166e-02  0.0588686246  0.054652026 -0.0001300024  0.593716684
## 2013-06-28 -1.258954e-01  0.0310507506 -0.030167145  0.0029917848  0.093672163
## 2013-07-31  1.321024e-01  0.0813355350  0.028091490  0.0495566813  0.223739522
## 2013-08-30  8.044258e-02 -0.0695574090  0.026270537 -0.0304718706  0.229971642
## 2013-09-30 -2.172368e-02  0.1067688897  0.053460223 -0.0299738826  0.134706620
## 2013-10-31  9.201566e-02  0.1521839116 -0.024066382  0.0738224351 -0.189806595
## 2013-11-29  6.770830e-02  0.0781496860  0.032035192  0.0420742660 -0.228409405
## 2013-12-31  8.861779e-03  0.0130490386  0.026566618 -0.0339343415  0.167108541
## 2014-01-31 -1.139489e-01 -0.1059765119 -0.020176938 -0.0531033942  0.187261714
## 2014-02-28  5.591782e-02  0.0094619003  0.162107505  0.0262766937  0.299722785
## 2014-03-31  1.975687e-02 -0.0737086161 -0.025904073  0.0243637322 -0.160783242
## 2014-04-30  9.476062e-02 -0.1007565303  0.030788766  0.0318632007 -0.002690122
## 2014-05-30  7.576580e-02  0.0273091844  0.032886335 -0.0215510362 -0.000577422
## 2014-06-30  2.728599e-02  0.0383836202 -0.024508477 -0.0276084090  0.144457224
## 2014-07-31  2.832597e-02 -0.0369768154 -0.057729555 -0.0083353479 -0.072372676
## 2014-08-29  7.465188e-02  0.0799468404  0.110060098  0.0722122277  0.188794007
## 2014-09-30 -1.722019e-02 -0.0502010184 -0.052782823  0.0075520856 -0.105566477
## 2014-10-31  6.948858e-02 -0.0540982347  0.057399276  0.0489305029 -0.004046477
## 2014-11-28  1.007307e-01  0.1031187277  0.074852212  0.0355689994  0.011599801
## 2014-12-31 -7.460606e-02 -0.0872368614 -0.044863658  0.0072717294 -0.094774519
## 2015-01-30  5.961169e-02  0.1330922557 -0.043318962 -0.0704973224 -0.088365289
## 2015-02-27  9.601577e-02  0.0697992426  0.142699105  0.0099162649 -0.001277808
## 2015-03-31 -3.187401e-02 -0.0214295755 -0.052582725 -0.0381918567 -0.074350051
## 2015-04-30  5.769703e-03  0.1253212736  0.058909118 -0.0220931969  0.180226808
## 2015-05-29  4.434136e-02  0.0175090293  0.001459621 -0.0141865589  0.103899574
## 2015-06-30 -3.793830e-02  0.0112589814 -0.095716905 -0.0019155452  0.067300935
## 2015-07-31 -3.348104e-02  0.2111621090 -0.007988068 -0.0117240380 -0.007896616
## 2015-08-31 -6.848880e-02 -0.0443525782  0.123595412 -0.0818806356 -0.066366250
## 2015-09-30 -2.205776e-02 -0.0019516837  0.092151114  0.0178111113 -0.002653519
## 2015-10-30  8.011232e-02  0.2010808743  0.140555105  0.0688365093 -0.182659777
## 2015-11-30 -5.820991e-03  0.0602956777  0.115405446 -0.0203686934  0.106828586
## 2015-12-31 -1.167903e-01  0.0165440008  0.038347207  0.0592719342  0.041471519
## 2016-01-29 -7.822369e-02 -0.1410054620 -0.118048559  0.0369855637 -0.227360626
## 2016-02-29 -1.288697e-03 -0.0605352209  0.071923725 -0.0172867152  0.003810669
## 2016-03-31  1.197464e-01  0.0717834363  0.127654643  0.0248478003  0.179948109
## 2016-04-29 -1.507310e-01  0.1053453760 -0.002810478 -0.0188090253  0.046721797
## 2016-05-31  6.931445e-02  0.0915002899  0.276388463  0.0114174211 -0.075597968
## 2016-06-30 -4.359658e-02 -0.0099694639  0.006188222  0.0438185167 -0.050296440
## 2016-07-29  8.623527e-02  0.0586021229  0.194443539  0.0186126851  0.100785334
## 2016-08-31  2.337629e-02  0.0135476418  0.073469219  0.0198965857 -0.102058091
## 2016-09-30  6.344851e-02  0.0848953908  0.110693259  0.0275629474 -0.038366372
## 2016-10-31  4.324888e-03 -0.0583893058  0.037805384 -0.0257302441 -0.031364583
## 2016-11-30 -2.183791e-02 -0.0509721927  0.260525274 -0.0512937543 -0.043041267
## 2016-12-30  4.684092e-02 -0.0009330556  0.146435672  0.0194556607  0.120665178
## 2017-01-31  4.664158e-02  0.0936394059  0.022602021  0.0489062377  0.164624916
## 2017-02-28  1.255554e-01  0.0258446800 -0.071874936  0.0388478453 -0.007730364
## 2017-03-31  4.754151e-02  0.0479423007  0.070843655 -0.0134871217  0.107278727
## 2017-04-28 -6.974621e-05  0.0424566944 -0.043434144 -0.0208193552  0.120916212
## 2017-05-31  6.560758e-02  0.0725778018  0.326022441  0.0086647603  0.082295892
## 2017-06-30 -5.891603e-02 -0.0271286156  0.001453401 -0.0107280505  0.058654468
## 2017-07-31  3.218046e-02  0.0202278808  0.117044958  0.0490634381 -0.111459860
## 2017-08-31  1.016530e-01 -0.0072953953  0.042639770  0.0158394028  0.095543446
## 2017-09-29 -6.213511e-02 -0.0198260355  0.053601153 -0.0140790374 -0.042474144
## 2017-10-31  9.240422e-02  0.1395154056  0.145700108 -0.0448811236 -0.028457409
## 2017-11-30  2.007511e-02  0.0626577318 -0.029244614  0.0414054921 -0.070862541
## 2017-12-29 -1.536336e-02 -0.0062057845 -0.036583530  0.0207847911  0.008061928
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 on 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.2, 0.2, 0.2, 0.2, 0.2)) 
## # A tibble: 1 × 5
##    AAPL  AMZN  NVDA    PG  TSLA
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.165 0.169 0.232 0.028 0.406
plot_data <- asset_returns_wide_tbl %>%
    
    calculate_component_contribution(w = c(0.2, 0.2, 0.2, 0.2, 0.2)) %>%
    
    # Transform to long form
    pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>%
    
    # Add weights
    add_column(weight = c(0.2, 0.2, 0.2, 0.2, 0.2)) %>%
    
    # 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?

Based on the results, TSLA has the largest contribution to the portfolio volatility with a contribution of 40.6%.

Do you think your portfolio risk is concentrated in any one asset?

Yes, the portfolio risk is noticeably concentrated in TSLA. Even though it has a 20% weight, it contributes over 40% of the total volatility, far more than any other asset. This shows that TSLA is the main driver of portfolio risk.

AAPL, AMZN, and NVDA also contribute a moderate amount to volatility, but none come close to TSLA’s impact. PG contributes very little, despite having the same weight as several other stocks, so it doesn’t significantly affect risk.

Overall, while multiple assets influence the portfolio, the risk is heavily tilted toward TSLA, meaning the portfolio is somewhat concentrated. Reducing TSLA’s weight or adding lower-correlated assets would help balance the risk.