# 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("AAPL", "TSLA", "NFLX", "MTN", "DIS")

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

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          DIS           MTN         NFLX         TSLA
## 2013-01-31 -1.555891e-01  0.078945094 -0.0231914024  0.579217807  0.102078114
## 2013-02-28 -2.561105e-02  0.013091502  0.0442294560  0.129468379 -0.074128640
## 2013-03-28  2.850624e-03  0.039685566  0.1239322285  0.006360071  0.084208138
## 2013-04-30  2.709976e-04  0.101055605 -0.0329500633  0.132375020  0.354111531
## 2013-05-31  2.217154e-02  0.003811843  0.0603318920  0.046038179  0.593716684
## 2013-06-28 -1.258953e-01  0.001109062 -0.0370412628 -0.069356059  0.093672163
## 2013-07-31  1.321024e-01  0.023475366  0.0850319034  0.146848883  0.223739522
## 2013-08-30  8.044254e-02 -0.060905136  0.0151137144  0.149523815  0.229971642
## 2013-09-30 -2.172347e-02  0.058427054  0.0200908497  0.085363345  0.134706620
## 2013-10-31  9.201551e-02  0.061636415  0.0183266282  0.042020452 -0.189806595
## 2013-11-29  6.770812e-02  0.028033537  0.0730629544  0.126045633 -0.228409405
## 2013-12-31  8.861991e-03  0.092072694 -0.0046403281  0.006458091  0.167108541
## 2014-01-31 -1.139491e-01 -0.050880032 -0.0988386256  0.105976906  0.187261714
## 2014-02-28  5.591811e-02  0.106997957  0.0313450594  0.084967340  0.299722785
## 2014-03-31  1.975620e-02 -0.009199478 -0.0028627076 -0.235772622 -0.160783242
## 2014-04-30  9.476165e-02 -0.009159041 -0.0067657191 -0.089040653 -0.002690122
## 2014-05-30  7.576512e-02  0.057193768  0.0066225316  0.260398864 -0.000577422
## 2014-06-30  2.728610e-02  0.020383646  0.1075734512  0.053062785  0.144457224
## 2014-07-31  2.832618e-02  0.001631442 -0.0220078162 -0.041427371 -0.072372676
## 2014-08-29  7.465142e-02  0.045524507  0.0514985456  0.122147235  0.188794007
## 2014-09-30 -1.722036e-02 -0.009502045  0.0875148306 -0.056990921 -0.105566477
## 2014-10-31  6.948910e-02  0.026053279  0.0002985813 -0.138642147 -0.004046477
## 2014-11-28  1.007307e-01  0.012290242  0.0147125548 -0.125081717  0.011599801
## 2014-12-31 -7.460624e-02  0.030626958  0.0436540666 -0.014472733 -0.094774519
## 2015-01-30  5.961168e-02 -0.034894293 -0.0376811900  0.257187512 -0.088365289
## 2015-02-27  9.601598e-02  0.134740118  0.0005694778  0.072268016 -0.001277808
## 2015-03-31 -3.187422e-02  0.007752275  0.1699390703 -0.130782770 -0.074350051
## 2015-04-30  5.769499e-03  0.035863625 -0.0415593983  0.289324652  0.180226808
## 2015-05-29  4.434114e-02  0.015062664  0.0446488922  0.114579343  0.103899574
## 2015-06-30 -3.793775e-02  0.033587315  0.0569931238  0.051346180  0.067300935
## 2015-07-31 -3.348127e-02  0.055865224  0.0044769491  0.197231490 -0.007896616
## 2015-08-31 -6.848893e-02 -0.163696083 -0.0163605940  0.006278919 -0.066366250
## 2015-09-30 -2.205787e-02  0.003135937 -0.0303892148 -0.107942853 -0.002653519
## 2015-10-30  8.011265e-02  0.106983486  0.0927709050  0.048393445 -0.182659777
## 2015-11-30 -5.821045e-03 -0.002376611  0.0547907525  0.129220160  0.106828586
## 2015-12-31 -1.167905e-01 -0.070426735  0.0644606346 -0.075337490  0.041471519
## 2016-01-29 -7.822342e-02 -0.092250625 -0.0236382687 -0.219478322 -0.227360626
## 2016-02-29 -1.288781e-03 -0.003135750  0.0190966123  0.016950552  0.003810669
## 2016-03-31  1.197465e-01  0.038910639  0.0546073623  0.090226765  0.179948109
## 2016-04-29 -1.507310e-01  0.039003856 -0.0308370256 -0.127082275  0.046721797
## 2016-05-31  6.931406e-02 -0.039910421  0.0123425492  0.130402555 -0.075597968
## 2016-06-30 -4.359626e-02 -0.014210656  0.0575818928 -0.114425083 -0.050296440
## 2016-07-29  8.623492e-02 -0.012063820  0.0344154685 -0.002517413  0.100785334
## 2016-08-31  2.337669e-02 -0.015650850  0.1019784044  0.065736402 -0.102058091
## 2016-09-30  6.344814e-02 -0.017083396 -0.0098316059  0.011224670 -0.038366372
## 2016-10-31  4.325004e-03 -0.001832389  0.0213717941  0.236709154 -0.031364583
## 2016-11-30 -2.183735e-02  0.067070606 -0.0065443358 -0.065099283 -0.043041267
## 2016-12-30  4.684050e-02  0.057850180  0.0231785803  0.056493450  0.120665178
## 2017-01-31  4.664184e-02  0.059867826  0.0614884654  0.128033698  0.164624916
## 2017-02-28  1.255552e-01 -0.005073886  0.0546746513  0.010041084 -0.007730364
## 2017-03-31  4.754155e-02  0.029534977  0.0631143913  0.039185483  0.107278727
## 2017-04-28 -6.977477e-05  0.019302742  0.0295739231  0.029267777  0.120916212
## 2017-05-31  6.560712e-02 -0.068560337  0.0789601038  0.068984176  0.082295892
## 2017-06-30 -5.891564e-02 -0.015780709 -0.0481438181 -0.087485372  0.058654468
## 2017-07-31  3.218013e-02  0.041460580  0.0383518237  0.195442599 -0.111459860
## 2017-08-31  1.016538e-01 -0.082745077  0.0784063125 -0.039009333  0.095543446
## 2017-09-29 -6.213524e-02 -0.026331693  0.0007453901  0.037301404 -0.042474144
## 2017-10-31  9.240363e-02 -0.007740246  0.0088134666  0.079877197 -0.028457409
## 2017-11-30  2.007537e-02  0.069217923 -0.0169983605 -0.046100666 -0.070862541
## 2017-12-29 -1.536293e-02  0.033351507 -0.0531045780  0.023081621  0.008061928
covariance_matrix <- cov(asset_returns_wide_tbl)

covariance_matrix
##              AAPL          DIS           MTN          NFLX          TSLA
## AAPL 0.0048301421 5.731109e-04  1.066260e-03  0.0006512360  4.838981e-04
## DIS  0.0005731109 2.786560e-03  8.463594e-05  0.0019003249  1.349726e-03
## MTN  0.0010662599 8.463594e-05  2.427738e-03 -0.0003491204 -3.105253e-05
## NFLX 0.0006512360 1.900325e-03 -3.491204e-04  0.0177864943  4.989080e-03
## TSLA 0.0004838981 1.349726e-03 -3.105253e-05  0.0049890797  2.095735e-02
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.04688437
component_contribution <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]
component_contribution
##             AAPL         DIS        MTN       NFLX        TSLA
## [1,] 0.009292555 0.007315244 0.00298753 0.01972629 0.007562748
rowSums(component_contribution)
## [1] 0.04688437
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
    round(3) %>%
    as_tibble()

component_percentages
## # A tibble: 1 × 5
##    AAPL   DIS   MTN  NFLX  TSLA
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.198 0.156 0.064 0.421 0.161
component_percentages %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 AAPL         0.198
## 2 DIS          0.156
## 3 MTN          0.064
## 4 NFLX         0.421
## 5 TSLA         0.161
# 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   DIS   MTN  NFLX  TSLA
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.198 0.156 0.064 0.421 0.161

6 Plot: Colum Chart of Component Contribution and Weight

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 largest contributor to the portfolios volatility is Netflix as it is at almost 45%. I think that this is where alot of my portfolios risk is concentrated. This could be because of the times looked at as I think this would look very diffrent with more current data considering tesla is in my portfolio.

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