Week 14: Apply it 12
CHAPTER 10 Component Contribution to Standard Deviation
Blake Yaffe
2024-12-01
# 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.
five stocks: “H”, “GOOGL”, “NOK”, “BA”, “FOSL” from 2012-12-31 to 2017-12-31
1 Import stock prices
symbols <- c("H", "GOOGL", "NOK", "BA", "FOSL")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-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## BA FOSL GOOGL H NOK
## 2013-01-31 -0.019969710 0.1257948088 0.066063227 0.038152957 -0.007624234
## 2013-02-28 0.046601945 -0.0269755278 0.058479372 0.025137158 -0.071364243
## 2013-03-28 0.110095581 -0.0619147235 -0.008787947 0.050769690 -0.106883750
## 2013-04-30 0.062753479 0.0156125220 0.037539332 -0.012804155 0.030032378
## 2013-05-31 0.085096770 0.0791328327 0.055032480 -0.037235829 0.017595411
## 2013-06-28 0.033955179 -0.0275899268 0.010447711 -0.018655333 0.083614320
## 2013-07-31 0.025635255 0.0618367221 0.008347916 0.114363215 0.052095021
## 2013-08-30 -0.006749613 0.0552254794 -0.047107529 -0.041743048 -0.010204051
## 2013-09-30 0.122816704 0.0008606462 0.033680780 -0.010189878 0.512362881
## 2013-10-31 0.104935216 0.0880575522 0.162613645 0.102563267 0.158748229
## 2013-11-29 0.031968049 0.0025962345 0.027760265 0.016047072 0.054825863
## 2013-12-31 0.016547576 -0.0593191495 0.056080359 0.022284304 0.006184209
## 2014-01-31 -0.085859713 -0.0700117607 0.052373813 -0.034347867 -0.158682002
## 2014-02-28 0.034424821 0.0271693677 0.028942789 0.087499663 0.091097479
## 2014-03-31 -0.026966209 0.0143427032 -0.086864165 0.031143339 -0.032174333
## 2014-04-30 0.027741477 -0.0889394891 -0.041981023 0.044879936 0.021564103
## 2014-05-30 0.052752972 -0.0178804192 0.066484522 0.083154117 0.080657799
## 2014-06-30 -0.061128489 -0.0022936315 0.022520641 -0.002947422 -0.009382790
## 2014-07-31 -0.054512761 -0.0644109299 -0.008795566 -0.035894020 0.047781892
## 2014-08-29 0.057165142 0.0330202201 0.004836773 0.037696261 0.054000831
## 2014-09-30 0.004563727 -0.0757572963 0.010335212 -0.009374413 0.010695276
## 2014-10-31 -0.019581364 0.0794035456 -0.035531479 -0.021714516 -0.022714511
## 2014-11-28 0.078747011 0.0943618040 -0.033648376 -0.004908935 -0.003634385
## 2014-12-31 -0.033141924 -0.0088106599 -0.034122598 0.021488030 -0.047213733
## 2015-01-30 0.111901312 -0.1242604839 0.012900258 -0.067854537 -0.033638373
## 2015-02-27 0.043169954 -0.1284610148 0.045600426 0.073320378 0.052542506
## 2015-03-31 -0.005117386 -0.0422715814 -0.014194811 -0.022044936 -0.055177605
## 2015-04-30 -0.045949070 0.0183867032 -0.010748058 -0.019954628 -0.141478692
## 2015-05-29 -0.013481605 -0.1677579730 -0.006306542 -0.010215646 0.127081600
## 2015-06-30 -0.012892487 -0.0235104010 -0.009729557 -0.013491128 -0.062255125
## 2015-07-31 0.038535773 -0.0088336047 0.196801618 -0.015286429 0.028779011
## 2015-08-31 -0.091881927 -0.1101395643 -0.014831965 -0.085986163 -0.122047437
## 2015-09-30 0.002064154 -0.0971306187 -0.014694816 -0.084052302 0.082997100
## 2015-10-30 0.122869421 -0.0266585958 0.144198855 0.067718271 0.090201881
## 2015-11-30 -0.011688617 -0.3466692092 0.033944592 -0.022270108 -0.028710141
## 2015-12-31 -0.005930304 -0.0509239643 0.019677824 -0.047148231 -0.026705697
## 2016-01-29 -0.185327721 -0.1146425426 -0.021646147 -0.195250342 0.025317526
## 2016-02-29 -0.007154290 0.3639186275 -0.059710650 0.176574259 -0.177333986
## 2016-03-31 0.071505589 -0.0545410918 0.061744439 0.069873707 -0.020100990
## 2016-04-29 0.060077912 -0.0923878031 -0.074852387 -0.033072666 -0.006791373
## 2016-05-31 -0.058196994 -0.3737511025 0.056264152 -0.042015128 -0.029388436
## 2016-06-30 0.029062177 0.0234053177 -0.062428276 0.067990618 0.052914819
## 2016-07-29 0.028765509 0.1022009434 0.117617259 0.026111160 0.013961437
## 2016-08-31 -0.023751747 -0.1011500139 -0.001884610 0.058523181 -0.017482846
## 2016-09-30 0.017535778 -0.0280508010 0.017830718 -0.083007558 0.020943330
## 2016-10-31 0.078020017 -0.0181691042 0.007236893 0.031399343 -0.256509521
## 2016-11-30 0.063161110 0.2033672547 -0.042912962 0.010770592 -0.041007879
## 2016-12-30 0.033440875 -0.2564570714 0.021131753 0.073579201 0.112082056
## 2017-01-31 0.048521046 -0.0112776196 0.034406452 -0.010003006 -0.062185162
## 2017-02-28 0.106475336 -0.3017289028 0.029717749 -0.063576195 0.128541278
## 2017-03-31 -0.018875279 -0.0803511822 0.003390998 0.050143479 0.053042802
## 2017-04-28 0.044078035 -0.0115275489 0.086630048 0.027769421 0.055619438
## 2017-05-31 0.022661687 -0.4710476098 0.065486471 0.038874210 0.126227095
## 2017-06-30 0.052531656 -0.0397779771 -0.059920804 -0.026162599 -0.025642489
## 2017-07-31 0.203833203 0.0833815721 0.016873469 -0.011451089 0.036657492
## 2017-08-31 -0.005669012 -0.3053181641 0.010248746 0.068500798 -0.033416092
## 2017-09-29 0.058939495 0.1181850421 0.019161110 0.037597248 -0.032897388
## 2017-10-31 0.014721450 -0.1689070883 0.059137433 0.013981683 -0.201228352
## 2017-11-30 0.075774409 -0.1070540215 0.003025223 0.143930321 0.024243691
## 2017-12-29 0.063375099 0.0929962650 0.016491862 0.016176016 -0.072420542# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## BA FOSL GOOGL H NOK
## BA 0.0038151311 0.0015454773 0.0008389107 0.0012913664 0.0019231747
## FOSL 0.0015454773 0.0186695913 -0.0008553183 0.0019644258 -0.0019577897
## GOOGL 0.0008389107 -0.0008553183 0.0029010236 0.0004560584 0.0012957020
## H 0.0012913664 0.0019644258 0.0004560584 0.0036894513 0.0001341955
## NOK 0.0019231747 -0.0019577897 0.0012957020 0.0001341955 0.0111071427# 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.048878# 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## BA FOSL GOOGL H NOK
## [1,] 0.01001742 0.02598209 0.003260709 0.006777977 0.002839805rowSums(component_contribution)## [1] 0.048878# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages## # A tibble: 1 × 5
## BA FOSL GOOGL H NOK
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.205 0.532 0.067 0.139 0.058component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")## # A tibble: 5 × 2
## asset contribution
## <chr> <dbl>
## 1 BA 0.205
## 2 FOSL 0.532
## 3 GOOGL 0.067
## 4 H 0.139
## 5 NOK 0.0584 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## BA FOSL GOOGL H NOK
## 2013-01-31 -0.019969710 0.1257948088 0.066063227 0.038152957 -0.007624234
## 2013-02-28 0.046601945 -0.0269755278 0.058479372 0.025137158 -0.071364243
## 2013-03-28 0.110095581 -0.0619147235 -0.008787947 0.050769690 -0.106883750
## 2013-04-30 0.062753479 0.0156125220 0.037539332 -0.012804155 0.030032378
## 2013-05-31 0.085096770 0.0791328327 0.055032480 -0.037235829 0.017595411
## 2013-06-28 0.033955179 -0.0275899268 0.010447711 -0.018655333 0.083614320
## 2013-07-31 0.025635255 0.0618367221 0.008347916 0.114363215 0.052095021
## 2013-08-30 -0.006749613 0.0552254794 -0.047107529 -0.041743048 -0.010204051
## 2013-09-30 0.122816704 0.0008606462 0.033680780 -0.010189878 0.512362881
## 2013-10-31 0.104935216 0.0880575522 0.162613645 0.102563267 0.158748229
## 2013-11-29 0.031968049 0.0025962345 0.027760265 0.016047072 0.054825863
## 2013-12-31 0.016547576 -0.0593191495 0.056080359 0.022284304 0.006184209
## 2014-01-31 -0.085859713 -0.0700117607 0.052373813 -0.034347867 -0.158682002
## 2014-02-28 0.034424821 0.0271693677 0.028942789 0.087499663 0.091097479
## 2014-03-31 -0.026966209 0.0143427032 -0.086864165 0.031143339 -0.032174333
## 2014-04-30 0.027741477 -0.0889394891 -0.041981023 0.044879936 0.021564103
## 2014-05-30 0.052752972 -0.0178804192 0.066484522 0.083154117 0.080657799
## 2014-06-30 -0.061128489 -0.0022936315 0.022520641 -0.002947422 -0.009382790
## 2014-07-31 -0.054512761 -0.0644109299 -0.008795566 -0.035894020 0.047781892
## 2014-08-29 0.057165142 0.0330202201 0.004836773 0.037696261 0.054000831
## 2014-09-30 0.004563727 -0.0757572963 0.010335212 -0.009374413 0.010695276
## 2014-10-31 -0.019581364 0.0794035456 -0.035531479 -0.021714516 -0.022714511
## 2014-11-28 0.078747011 0.0943618040 -0.033648376 -0.004908935 -0.003634385
## 2014-12-31 -0.033141924 -0.0088106599 -0.034122598 0.021488030 -0.047213733
## 2015-01-30 0.111901312 -0.1242604839 0.012900258 -0.067854537 -0.033638373
## 2015-02-27 0.043169954 -0.1284610148 0.045600426 0.073320378 0.052542506
## 2015-03-31 -0.005117386 -0.0422715814 -0.014194811 -0.022044936 -0.055177605
## 2015-04-30 -0.045949070 0.0183867032 -0.010748058 -0.019954628 -0.141478692
## 2015-05-29 -0.013481605 -0.1677579730 -0.006306542 -0.010215646 0.127081600
## 2015-06-30 -0.012892487 -0.0235104010 -0.009729557 -0.013491128 -0.062255125
## 2015-07-31 0.038535773 -0.0088336047 0.196801618 -0.015286429 0.028779011
## 2015-08-31 -0.091881927 -0.1101395643 -0.014831965 -0.085986163 -0.122047437
## 2015-09-30 0.002064154 -0.0971306187 -0.014694816 -0.084052302 0.082997100
## 2015-10-30 0.122869421 -0.0266585958 0.144198855 0.067718271 0.090201881
## 2015-11-30 -0.011688617 -0.3466692092 0.033944592 -0.022270108 -0.028710141
## 2015-12-31 -0.005930304 -0.0509239643 0.019677824 -0.047148231 -0.026705697
## 2016-01-29 -0.185327721 -0.1146425426 -0.021646147 -0.195250342 0.025317526
## 2016-02-29 -0.007154290 0.3639186275 -0.059710650 0.176574259 -0.177333986
## 2016-03-31 0.071505589 -0.0545410918 0.061744439 0.069873707 -0.020100990
## 2016-04-29 0.060077912 -0.0923878031 -0.074852387 -0.033072666 -0.006791373
## 2016-05-31 -0.058196994 -0.3737511025 0.056264152 -0.042015128 -0.029388436
## 2016-06-30 0.029062177 0.0234053177 -0.062428276 0.067990618 0.052914819
## 2016-07-29 0.028765509 0.1022009434 0.117617259 0.026111160 0.013961437
## 2016-08-31 -0.023751747 -0.1011500139 -0.001884610 0.058523181 -0.017482846
## 2016-09-30 0.017535778 -0.0280508010 0.017830718 -0.083007558 0.020943330
## 2016-10-31 0.078020017 -0.0181691042 0.007236893 0.031399343 -0.256509521
## 2016-11-30 0.063161110 0.2033672547 -0.042912962 0.010770592 -0.041007879
## 2016-12-30 0.033440875 -0.2564570714 0.021131753 0.073579201 0.112082056
## 2017-01-31 0.048521046 -0.0112776196 0.034406452 -0.010003006 -0.062185162
## 2017-02-28 0.106475336 -0.3017289028 0.029717749 -0.063576195 0.128541278
## 2017-03-31 -0.018875279 -0.0803511822 0.003390998 0.050143479 0.053042802
## 2017-04-28 0.044078035 -0.0115275489 0.086630048 0.027769421 0.055619438
## 2017-05-31 0.022661687 -0.4710476098 0.065486471 0.038874210 0.126227095
## 2017-06-30 0.052531656 -0.0397779771 -0.059920804 -0.026162599 -0.025642489
## 2017-07-31 0.203833203 0.0833815721 0.016873469 -0.011451089 0.036657492
## 2017-08-31 -0.005669012 -0.3053181641 0.010248746 0.068500798 -0.033416092
## 2017-09-29 0.058939495 0.1181850421 0.019161110 0.037597248 -0.032897388
## 2017-10-31 0.014721450 -0.1689070883 0.059137433 0.013981683 -0.201228352
## 2017-11-30 0.075774409 -0.1070540215 0.003025223 0.143930321 0.024243691
## 2017-12-29 0.063375099 0.0929962650 0.016491862 0.016176016 -0.072420542calculate_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
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")
return(component_percentages)
}
asset_returns_wide_tbl %>% calculate_component_contribution(w = c(.25,.25,.20,.20,.10))## # A tibble: 1 × 5
## BA FOSL GOOGL H NOK
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.205 0.532 0.067 0.139 0.0585 Visualizing Component Contribution
column chart of component contribution
plot_data <- asset_returns_wide_tbl %>% calculate_component_contribution(w = c(.25,.25,.20,.20,.10)) %>%
# transform to long form
pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contributions")
plot_data %>%
ggplot(aes(x = Asset, y = Contributions)) +
geom_col(fill = "steelblue") +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme(plot.title = element_text(hjust = .5)) +
labs(title = "Percent Contribution to Portfolio Standerd Deveiation")
column chart of component contribution and weight
plot_data <- asset_returns_wide_tbl %>% calculate_component_contribution(w = c(.25,.25,.20,.20,.10)) %>%
# transform to long form
pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contributions") %>%
# add wights
add_column(weight = c(.25,.25,.20,.20,.10)) %>%
# transform to long
pivot_longer(cols = c(Contributions, 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 = .5)) +
theme_tq() +
labs(title = "Percent Contribution to Portfolio volitlity and weight",
y = "Percent",
x = NULL)