# 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("PLTR", "IBM", "BLK", "TSM", "SLB")

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

prices
## # A tibble: 4,895 × 8
##    symbol date        open  high   low close   volume adjusted
##    <chr>  <date>     <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl>
##  1 PLTR   2020-12-31  24.6  24.7  23.5  23.5 39922500     23.5
##  2 PLTR   2021-01-04  23.9  24.5  22.5  23.4 44970400     23.4
##  3 PLTR   2021-01-05  23.2  24.7  22.9  24.6 29050400     24.6
##  4 PLTR   2021-01-06  24.1  24.5  23.2  23.5 32732900     23.5
##  5 PLTR   2021-01-07  24.0  25.2  23.7  25   32240000     25  
##  6 PLTR   2021-01-08  25.7  26.4  24.7  25.2 41313800     25.2
##  7 PLTR   2021-01-11  24.6  26.6  24.3  25.9 32609000     25.9
##  8 PLTR   2021-01-12  26.3  26.4  25.5  26.2 26887200     26.2
##  9 PLTR   2021-01-13  25.7  27.4  25.1  25.5 51216600     25.5
## 10 PLTR   2021-01-14  25.5  25.6  24.4  24.9 32908000     24.9
## # ℹ 4,885 more rows

2 Convert prices to returns (monthly)

asset_returns_tbl1 <- prices %>%
    
    group_by(symbol) %>%
    
    tq_transmute(select     = adjusted,
                 mutate_fun = periodReturn,
                 period     = "monthly",
                 type       = "log") %>%
    
    slice(-1) %>%
    
    ungroup() %>%
    
    set_names(c("asset", "date", "returns"))

asset_returns_tbl1
## # A tibble: 235 × 3
##    asset date        returns
##    <chr> <date>        <dbl>
##  1 BLK   2021-01-29 -0.0285 
##  2 BLK   2021-02-26 -0.00969
##  3 BLK   2021-03-31  0.0881 
##  4 BLK   2021-04-30  0.0831 
##  5 BLK   2021-05-28  0.0681 
##  6 BLK   2021-06-30  0.00230
##  7 BLK   2021-07-30 -0.00895
##  8 BLK   2021-08-31  0.0841 
##  9 BLK   2021-09-30 -0.113  
## 10 BLK   2021-10-29  0.118  
## # ℹ 225 more rows

3 Calculate Component Contribution to Portfolio Volatility

# Transform data into wide form
asset_returns_wide_tbl1 <- asset_returns_tbl1 %>%

    pivot_wider(names_from = asset, values_from = returns) %>%

    column_to_rownames(var = "date")

asset_returns_wide_tbl1
##                     BLK           IBM         PLTR          SLB          TSM
## 2021-01-29 -0.028509015 -0.0552816921  0.401351960  0.017257708  0.108363943
## 2021-02-26 -0.009686429  0.0117619825 -0.386599305  0.233122559  0.035726769
## 2021-03-31  0.088051937  0.1137671276 -0.025854320 -0.026135685 -0.058990152
## 2021-04-30  0.083111012  0.0626795105 -0.010792248 -0.005162410 -0.013105554
## 2021-05-28  0.068102238  0.0241356318 -0.003913906  0.146889325  0.005296961
## 2021-06-30  0.002301702  0.0196334195  0.138529763  0.025469944  0.027406763
## 2021-07-30 -0.008954455 -0.0391632190 -0.194074791 -0.104631843 -0.029731798
## 2021-08-31  0.084138689  0.0070388758  0.193315760 -0.023354531  0.020115170
## 2021-09-30 -0.113214733 -0.0100979469 -0.091369554  0.055492625 -0.059739543
## 2021-10-29  0.117748731 -0.1048567722  0.073751289  0.084703317  0.018194396
## 2021-11-30 -0.042050053 -0.0078558090 -0.225755136 -0.113403194  0.029891743
## 2021-12-31  0.016633609  0.1322711384 -0.125744457  0.043329214  0.030744721
## 2022-01-31 -0.106652554 -0.0006736593 -0.283845347  0.265825543  0.019099881
## 2022-02-28 -0.100990094 -0.0744595352 -0.145797597  0.007450716 -0.136249489
## 2022-03-31  0.033534033  0.0594956402  0.147255287  0.051407982 -0.021223094
## 2022-04-29 -0.201550780  0.0167032705 -0.277777417 -0.057286663 -0.115041307
## 2022-05-31  0.068664139  0.0609881041 -0.180784206  0.167590006  0.025183235
## 2022-06-30 -0.086885609  0.0167843042  0.043950667 -0.250941501 -0.148110802
## 2022-07-29  0.094169016 -0.0765133006  0.132014326  0.034898354  0.079110872
## 2022-08-31 -0.004177876 -0.0055327918 -0.293172220  0.029797468 -0.059728024
## 2022-09-30 -0.184004631 -0.0780141319  0.051746601 -0.056181074 -0.189699470
## 2022-10-31  0.160233184  0.1518272805  0.078053770  0.371083017 -0.107859491
## 2022-11-30  0.103019733  0.0857743558 -0.158711687 -0.009268223  0.298749779
## 2022-12-30 -0.003476367 -0.0552955571 -0.155484891  0.039793439 -0.102282582
## 2023-01-31  0.068944888 -0.0447065750  0.192138236  0.063766498  0.219027087
## 2023-02-28 -0.096413157 -0.0289290839  0.007682489 -0.063733822 -0.062979779
## 2023-03-31 -0.022684122  0.0137487424  0.074927565 -0.080387293  0.071294391
## 2023-04-28  0.003103750 -0.0363534522 -0.086473575  0.005078753 -0.098432461
## 2023-05-31 -0.020546310  0.0306418315  0.640834694 -0.141699003  0.156587696
## 2023-06-30  0.057148491  0.0397918331  0.041284151  0.142451120  0.027538073
## 2023-07-31  0.066752495  0.0746416897  0.257888422  0.172021712 -0.017694213
## 2023-08-31 -0.053243527  0.0296550696 -0.280984162  0.010571228 -0.057924091
## 2023-09-29 -0.073064949 -0.0454925954  0.065872775 -0.007090066 -0.068775149
## 2023-10-31 -0.054367978  0.0304649446 -0.077961529 -0.046340322 -0.006812535
## 2023-11-30  0.204522197  0.1031625469  0.303601922 -0.067249125  0.119956188
## 2023-12-29  0.084192863  0.0309856669 -0.155065436  0.004816481  0.071190905
## 2024-01-31 -0.047281665  0.1159675462 -0.064965709 -0.066333713  0.082642790
## 2024-02-29  0.046714887  0.0165072159  0.443872742 -0.001946008  0.130217238
## 2024-03-28  0.033372892  0.0315460752 -0.086141799  0.125820111  0.059824153
## 2024-04-30 -0.099632857 -0.1388720955 -0.046251059 -0.143564103  0.009437064
## 2024-05-31  0.022782582  0.0137812272 -0.013287664 -0.034061404  0.095085074
## 2024-06-28  0.026183727  0.0359072787  0.155599270  0.034078006  0.143567937
## 2024-07-31  0.107301896  0.1052217496  0.059764987  0.023254452 -0.047180510
## 2024-08-30  0.028467115  0.0593949946  0.157597961 -0.093262148  0.034966481
## 2024-09-30  0.057442537  0.0896135608  0.166956373 -0.040959925  0.015092359
## 2024-10-31  0.032656998 -0.0671594001  0.110829417 -0.045850534  0.092705175
## 2024-11-20  0.043522861  0.0452608295  0.401929782  0.082822410 -0.011507082
# Covariance of asset returns
covariance_matrix1 <- cov(asset_returns_wide_tbl1)

covariance_matrix1
##              BLK          IBM          PLTR           SLB           TSM
## BLK  0.007054669 0.0024340667  0.0057875381  0.0030473080  0.0035689581
## IBM  0.002434067 0.0041386335  0.0009140293  0.0016291069  0.0008454151
## PLTR 0.005787538 0.0009140293  0.0448425117 -0.0038790119  0.0066852947
## SLB  0.003047308 0.0016291069 -0.0038790119  0.0123606549 -0.0001585173
## TSM  0.003568958 0.0008454151  0.0066852947 -0.0001585173  0.0090913591
# 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_portfolio1 <- sqrt(t(w) %*% covariance_matrix1 %*% w)
sd_portfolio1
##            [,1]
## [1,] 0.06849925
# 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_contribution1 <- (t(w) %*% covariance_matrix1 * w) / sd_portfolio1[1,1]
component_contribution1
##             BLK         IBM      PLTR         SLB         TSM
## [1,] 0.01640912 0.008161928 0.0307642 0.008320035 0.004843972
rowSums(component_contribution1)
## [1] 0.06849925
# Component contribution in percentage
component_percentages1 <- (component_contribution1 / sd_portfolio1[1,1]) %>%
    round(3) %>%
    as_tibble()

component_percentages1
## # A tibble: 1 × 5
##     BLK   IBM  PLTR   SLB   TSM
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1  0.24 0.119 0.449 0.121 0.071
component_percentages1 %>%

    as_tibble() %>%
    gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
##   asset contribution
##   <chr>        <dbl>
## 1 BLK          0.24 
## 2 IBM          0.119
## 3 PLTR         0.449
## 4 SLB          0.121
## 5 TSM          0.071
asset_returns_wide_tbl1 <- asset_returns_tbl1 %>%

    pivot_wider(names_from = asset, values_from = returns) %>%

    column_to_rownames(var = "date")


calculate_component_contribution1 <- function(asset_returns_wide_tbl1, w) {

    covariance_matrix <- cov(asset_returns_wide_tbl1)
    
    
    sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)

    
    component_contribution1 <- (t(w) %*% covariance_matrix * w) / sd_portfolio[1,1]

    
    component_percentages1 <- (component_contribution1 / sd_portfolio[1,1]) %>%
        round(3) %>%
        as_tibble()
    
    return(component_percentages1)

}

asset_returns_wide_tbl1 %>% calculate_component_contribution1(w = c(0.25,0.25,0.2,0.2,0.1))
## # A tibble: 1 × 5
##     BLK   IBM  PLTR   SLB   TSM
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1  0.24 0.119 0.449 0.121 0.071

6 Plot: Colum Chart of Component Contribution and Weight

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

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

plot_data1 <- asset_returns_wide_tbl1 %>% calculate_component_contribution1(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_data1 %>%
    
    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?

Palantir is the largest contributor to my portfolios volatility. Its contribution percentage is over 2x its weight in the portfolio. This can be attributed to it still being relatively new to the market, in a high performing sector. I dont think its fair to say the entire risk of the portfolio is attributed to Palantir, given Blackrock has a contribution percentage of roughly 25%. With that being said, Palantir accounts for 45% of my portfolios volatility while holding a 20% weight.