# Load packages
# Core
library(tidyverse)
library(tidyquant)
Examine how each asset contributes to portfolio standard deviation. This is to ensure that our risk is not concentrated in any one asset.
symbols <- c("AMZN", "AAPL", "NFLX", "BA", "DELL")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2023-12-01")
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"))
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 BA DELL NFLX
## 2013-01-31 -1.555893e-01 0.0566799395 -0.019969830 NA 0.5792178072
## 2013-02-28 -2.561083e-02 -0.0046435024 0.046601883 NA 0.1294683790
## 2013-03-28 2.850402e-03 0.0083654162 0.110095792 NA 0.0063600708
## 2013-04-30 2.709332e-04 -0.0487507497 0.062753170 NA 0.1323750202
## 2013-05-31 2.217165e-02 0.0588686246 0.085096687 NA 0.0460381788
## 2013-06-28 -1.258955e-01 0.0310507506 0.033955536 NA -0.0693560587
## 2013-07-31 1.321023e-01 0.0813355350 0.025634823 NA 0.1468488828
## 2013-08-30 8.044237e-02 -0.0695574090 -0.006749528 NA 0.1495238153
## 2013-09-30 -2.172337e-02 0.1067688897 0.122817029 NA 0.0853633452
## 2013-10-31 9.201556e-02 0.1521839116 0.104934789 NA 0.0420204523
## 2013-11-29 6.770805e-02 0.0781496860 0.031968323 NA 0.1260456325
## 2013-12-31 8.862584e-03 0.0130490386 0.016547707 NA 0.0064580908
## 2014-01-31 -1.139499e-01 -0.1059765119 -0.085859773 NA 0.1059769064
## 2014-02-28 5.591897e-02 0.0094619003 0.034424612 NA 0.0849673396
## 2014-03-31 1.975581e-02 -0.0737086161 -0.026966000 NA -0.2357726219
## 2014-04-30 9.476120e-02 -0.1007565303 0.027741544 NA -0.0890406532
## 2014-05-30 7.576537e-02 0.0273091844 0.052752834 NA 0.2603988640
## 2014-06-30 2.728629e-02 0.0383836202 -0.061128628 NA 0.0530627854
## 2014-07-31 2.832613e-02 -0.0369768154 -0.054512549 NA -0.0414273713
## 2014-08-29 7.465163e-02 0.0799468404 0.057165069 NA 0.1221472352
## 2014-09-30 -1.722044e-02 -0.0502010184 0.004563727 NA -0.0569909207
## 2014-10-31 6.948904e-02 -0.0540982347 -0.019581154 NA -0.1386421470
## 2014-11-28 1.007306e-01 0.1031187277 0.078746995 NA -0.1250817171
## 2014-12-31 -7.460608e-02 -0.0872368614 -0.033142052 NA -0.0144727330
## 2015-01-30 5.961165e-02 0.1330922557 0.111901545 NA 0.2571875124
## 2015-02-27 9.601571e-02 0.0697992426 0.043169769 NA 0.0722680160
## 2015-03-31 -3.187407e-02 -0.0214295755 -0.005117501 NA -0.1307827695
## 2015-04-30 5.769542e-03 0.1253212736 -0.045949252 NA 0.2893246523
## 2015-05-29 4.434149e-02 0.0175090293 -0.013481424 NA 0.1145793430
## 2015-06-30 -3.793824e-02 0.0112589814 -0.012892177 NA 0.0513461801
## 2015-07-31 -3.348106e-02 0.2111621090 0.038535343 NA 0.1972314899
## 2015-08-31 -6.848894e-02 -0.0443525782 -0.091881611 NA 0.0062789186
## 2015-09-30 -2.205760e-02 -0.0019516837 0.002063892 NA -0.1079428532
## 2015-10-30 8.011219e-02 0.2010808743 0.122869949 NA 0.0483934447
## 2015-11-30 -5.820993e-03 0.0602956777 -0.011688963 NA 0.1292201596
## 2015-12-31 -1.167905e-01 0.0165440008 -0.005930421 NA -0.0753374900
## 2016-01-29 -7.822325e-02 -0.1410054620 -0.185327579 NA -0.2194783218
## 2016-02-29 -1.288447e-03 -0.0605352209 -0.007154645 NA 0.0169505524
## 2016-03-31 1.197461e-01 0.0717834363 0.071505803 NA 0.0902267645
## 2016-04-29 -1.507313e-01 0.1053453760 0.060077849 NA -0.1270822750
## 2016-05-31 6.931429e-02 0.0915002899 -0.058196865 NA 0.1304025548
## 2016-06-30 -4.359630e-02 -0.0099694639 0.029062111 NA -0.1144250835
## 2016-07-29 8.623507e-02 0.0586021229 0.028765322 NA -0.0025174134
## 2016-08-31 2.337651e-02 0.0135476418 -0.023751751 NA 0.0657364022
## 2016-09-30 6.344843e-02 0.0848953908 0.017535781 0.067499737 0.0112246699
## 2016-10-31 4.324994e-03 -0.0583893058 0.078020206 0.026629576 0.2367091536
## 2016-11-30 -2.183759e-02 -0.0509721927 0.063161110 0.087147156 -0.0650992833
## 2016-12-30 4.684058e-02 -0.0009330556 0.033440981 0.025985144 0.0564934501
## 2017-01-31 4.664184e-02 0.0936394059 0.048520940 0.136188404 0.1280336976
## 2017-02-28 1.255556e-01 0.0258446800 0.106475246 0.007906420 0.0100410836
## 2017-03-31 4.754066e-02 0.0479423007 -0.018875188 0.009249837 0.0391854826
## 2017-04-28 -6.952323e-05 0.0424566944 0.044077947 0.046200694 0.0292677767
## 2017-05-31 6.560730e-02 0.0725778018 0.022661861 0.033409963 0.0689841760
## 2017-06-30 -5.891556e-02 -0.0271286156 0.052531488 -0.127067279 -0.0874853720
## 2017-07-31 3.218055e-02 0.0202278808 0.203833152 0.050417301 0.1954425989
## 2017-08-31 1.016526e-01 -0.0072953953 -0.005668811 0.153461341 -0.0390093333
## 2017-09-29 -6.213436e-02 -0.0198260355 0.058939365 0.029974779 0.0373014045
## 2017-10-31 9.240367e-02 0.1395154056 0.014721451 0.069536497 0.0798771971
## 2017-11-30 2.007507e-02 0.0626577318 0.075774472 -0.056284575 -0.0461006656
## 2017-12-29 -1.536335e-02 -0.0062057845 0.063374990 0.038118988 0.0230816211
## 2018-01-31 -1.069328e-02 0.2156265497 0.183671410 -0.125409241 0.3422453562
## 2018-02-28 6.596091e-02 0.0415536279 0.026806630 0.035485625 0.0750958659
## 2018-03-29 -5.980391e-02 -0.0440034760 -0.099576390 -0.014644279 0.0135328404
## 2018-04-30 -1.513353e-02 0.0788803060 0.017175001 -0.019865561 0.0563153192
## 2018-05-31 1.267418e-01 0.0397392430 0.059238974 0.116776225 0.1180177495
## 2018-06-29 -9.462754e-03 0.0421636787 -0.048433780 0.047455185 0.1073124981
## 2018-07-31 2.759880e-02 0.0446635734 0.060121250 0.089726831 -0.1483892939
## 2018-08-31 1.826733e-01 0.1243079079 -0.033726040 0.038692682 0.0857955874
## 2018-09-28 -8.337769e-03 -0.0048359814 0.081506964 0.009829797 0.0173903689
## 2018-10-31 -3.095146e-02 -0.2258869989 -0.046901547 -0.071813606 -0.2149050726
## 2018-11-30 -1.999127e-01 0.0560700324 -0.018483264 0.154387724 -0.0532520010
## 2018-12-31 -1.240885e-01 -0.1180514843 -0.072529851 -0.178243301 -0.0667287380
## 2019-01-31 5.368684e-02 0.1348080312 0.178749274 -0.005745745 0.2377564149
## 2019-02-28 4.380296e-02 -0.0469930640 0.136842655 0.138714313 0.0533383470
## 2019-03-29 9.260262e-02 0.0824420184 -0.142782634 0.050137133 -0.0043097723
## 2019-04-30 5.490088e-02 0.0786806224 -0.009827463 0.138524184 0.0384589024
## 2019-05-31 -1.326322e-01 -0.0818753491 -0.094675438 -0.123977142 -0.0764149871
## 2019-06-28 1.226771e-01 0.0646557767 0.063511708 -0.158919958 0.0676869856
## 2019-07-31 7.361695e-02 -0.0142806686 -0.064771221 0.128053767 -0.1286120899
## 2019-08-30 -1.659804e-02 -0.0496880810 0.071211574 -0.113786151 -0.0948922673
## 2019-09-30 7.042259e-02 -0.0229951159 0.044006196 0.006383656 -0.0931610198
## 2019-10-31 1.049765e-01 0.0232034080 -0.112726399 0.019666533 0.0713417349
## 2019-11-29 7.469350e-02 0.0134958216 0.080262991 -0.086856597 0.0905829220
## 2019-12-31 9.420438e-02 0.0257863501 -0.116964019 0.058085989 0.0279227940
## 2020-01-31 5.260185e-02 0.0834803026 -0.023260958 -0.052328346 0.0643897455
## 2020-02-28 -1.218305e-01 -0.0642332026 -0.139796995 -0.186801501 0.0670726963
## 2020-03-31 -7.231422e-02 0.0344213022 -0.612285506 -0.022748102 0.0173805330
## 2020-04-30 1.444240e-01 0.2381504762 -0.055983703 0.076398933 0.1116390480
## 2020-05-29 8.166640e-02 -0.0128673719 0.033676984 0.150832320 -0.0002858456
## 2020-06-30 1.374868e-01 0.1218341331 0.228545433 0.101444736 0.0807736724
## 2020-07-31 1.528341e-01 0.1372488933 -0.148529138 0.085265587 0.0717317246
## 2020-08-31 1.960349e-01 0.0866005735 0.083852427 0.099358961 0.0799293979
## 2020-09-30 -1.081715e-01 -0.0916533253 -0.038927502 0.024072180 -0.0573783743
## 2020-10-30 -6.188827e-02 -0.0364089187 -0.135001990 -0.116269898 -0.0497966282
## 2020-11-30 9.120467e-02 0.0425228214 0.377964845 0.135872540 0.0309615020
## 2020-12-31 1.084721e-01 0.0276719582 0.015773526 0.059882914 0.0970870744
## 2021-01-29 -5.516956e-03 -0.0156985929 -0.097419264 -0.005472559 -0.0155437114
## 2021-02-26 -8.306843e-02 -0.0359675607 0.087796344 0.106361702 0.0120608627
## 2021-03-31 7.312631e-03 0.0003717151 0.183531490 0.083726855 -0.0324212105
## 2021-04-30 7.345310e-02 0.1139202399 -0.083519893 0.109289209 -0.0158244352
## 2021-05-28 -5.181688e-02 -0.0730764715 0.052824308 0.003147651 -0.0209791877
## 2021-06-30 9.450011e-02 0.0651836137 -0.030665425 0.010387925 0.0492816132
## 2021-07-30 6.295826e-02 -0.0332696301 -0.056147275 -0.031078935 -0.0203491777
## 2021-08-31 4.161130e-02 0.0421339363 -0.031304389 0.008656239 0.0950695060
## 2021-09-30 -7.046155e-02 -0.0550034409 0.002002560 0.065333373 0.0698019211
## 2021-10-29 5.700126e-02 0.0262547651 -0.060491089 0.055613974 0.1231245456
## 2021-11-30 9.991921e-02 0.0391473463 -0.045354506 0.012875439 -0.0727082022
## 2021-12-31 7.160302e-02 -0.0505062029 0.017386520 -0.005326746 -0.0634444870
## 2022-01-31 -1.583690e-02 -0.1085098142 -0.005379044 0.011329602 -0.3438762168
## 2022-02-28 -5.558235e-02 0.0263230079 0.025150449 -0.108671331 -0.0794420544
## 2022-03-31 5.588256e-02 0.0596239190 -0.069779315 -0.015225197 -0.0518377235
## 2022-04-29 -1.021777e-01 -0.2711856801 -0.252015930 -0.058475178 -0.6769150653
## 2022-05-31 -5.603722e-02 -0.0333130879 -0.124625819 0.060461950 0.0365177336
## 2022-06-30 -8.493678e-02 -0.1238178226 0.039688988 -0.077625976 -0.1213919403
## 2022-07-29 1.728044e-01 0.2394860591 0.152916927 -0.017479224 0.2516130190
## 2022-08-31 -3.170528e-02 -0.0625299224 0.005883122 -0.162806321 -0.0059760083
## 2022-09-30 -1.289443e-01 -0.1149865758 -0.280283597 -0.113840587 0.0517762908
## 2022-10-31 1.039558e-01 -0.0981105335 0.162960635 0.126329072 0.2148866613
## 2022-11-30 -3.358517e-02 -0.0593198454 0.227303083 0.153927475 0.0457051938
## 2022-12-30 -1.304192e-01 -0.1391406409 0.062884511 -0.107620541 -0.0354794590
## 2023-01-31 1.048294e-01 0.2051735029 0.111692437 0.017969579 0.1823328028
## 2023-02-28 2.291831e-02 -0.0902516639 -0.055254661 0.000492308 -0.0939461074
## 2023-03-31 1.121214e-01 0.0918019370 0.052574983 -0.010636989 0.0699795803
## 2023-04-28 2.857491e-02 0.0206963031 -0.026957068 0.087035031 -0.0460542977
## 2023-05-31 4.502921e-02 0.1340765703 -0.005236638 0.029900224 0.1805874132
## 2023-06-30 9.014237e-02 0.0779864104 0.026197375 0.188587727 0.1084198198
## 2023-07-31 1.270444e-02 0.0251489708 0.123219608 -0.015305698 -0.0034566451
## 2023-08-31 -4.330830e-02 0.0318772770 -0.064055799 0.060847018 -0.0121241583
## 2023-09-29 -9.285922e-02 -0.0821945627 -0.155952689 0.203027861 -0.1384714676
## 2023-10-31 -2.573323e-03 0.0458940197 -0.025681651 -0.023678152 0.0864351944
## 2023-11-30 1.077598e-01 0.0931972815 0.214995666 0.125672974 0.1408733862
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix
## AAPL AMZN BA DELL NFLX
## AAPL 0.006409116 0.003574357 0.002640537 NA 0.002946398
## AMZN 0.003574357 0.007560841 0.002739862 NA 0.006728813
## BA 0.002640537 0.002739862 0.011868821 NA 0.004294980
## DELL NA NA NA NA NA
## NFLX 0.002946398 0.006728813 0.004294980 NA 0.018318262
# 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,] NA
# 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 BA DELL NFLX
## [1,] NA NA NA NA NA
rowSums(component_contribution)
## [1] NA
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages
## # A tibble: 1 × 5
## AAPL AMZN BA DELL NFLX
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 NA NA NA NA NA
component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")
## # A tibble: 5 × 2
## asset contribution
## <chr> <dbl>
## 1 AAPL NA
## 2 AMZN NA
## 3 BA NA
## 4 DELL NA
## 5 NFLX NA
# 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 AMZN BA DELL NFLX
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 NA NA NA NA NA
# 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")
calculate_comp_contrib_by_window <- function(asset_returns_wide_tbl,
start = 1,
window = 24,
weights) {
# 1 Define start date
start_date <- rownames(asset_returns_wide_tbl)[start]
# 2 Define end date
end_date <- rownames(asset_returns_wide_tbl)[start + window]
# 3 Subset df
df_subset <- asset_returns_wide_tbl %>%
rownames_to_column(var = "date") %>%
filter(date >= start_date & date < end_date) %>%
column_to_rownames(var = "date")
# 4 Calculate component contribution
component_percentages <-df_subset %>%
calculate_component_contribution(w = weights)
# 5 Add end date to df
component_percentages %>%
mutate(date = ymd(end_date)) %>%
select(date, everything())
}
# Check the custom function
asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 1, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))
## # A tibble: 1 × 6
## date AAPL AMZN BA DELL NFLX
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 NA NA NA NA NA
asset_returns_wide_tbl %>% calculate_comp_contrib_by_window(start = 2, window = 24,
w = c(0.25,0.25,0.2,0.2,0.1))
## # A tibble: 1 × 6
## date AAPL AMZN BA DELL NFLX
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-02-27 NA NA NA NA NA
dump(list = c("calculate_component_contribution",
"calculate_comp_contrib_by_window"),
file = "../00_scripts/calculate_comp_contrib_to_portfolio_volatility.R")
# Iterate the custom function
w <- c(0.25,0.25,0.2,0.2,0.1)
window <- 24
rolling_comp_contrib_tbl <- 1:(nrow(asset_returns_wide_tbl) - window) %>%
map_df(.x = ., .f = ~calculate_comp_contrib_by_window(asset_returns_wide_tbl,
start = .x,
weights = w,
window = window))
rolling_comp_contrib_tbl
## # A tibble: 107 × 6
## date AAPL AMZN BA DELL NFLX
## <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-30 NA NA NA NA NA
## 2 2015-02-27 NA NA NA NA NA
## 3 2015-03-31 NA NA NA NA NA
## 4 2015-04-30 NA NA NA NA NA
## 5 2015-05-29 NA NA NA NA NA
## 6 2015-06-30 NA NA NA NA NA
## 7 2015-07-31 NA NA NA NA NA
## 8 2015-08-31 NA NA NA NA NA
## 9 2015-09-30 NA NA NA NA NA
## 10 2015-10-30 NA NA NA NA NA
## # ℹ 97 more rows
# Figure 10.3 Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
ggplot(aes(date, contribution, color = asset)) +
geom_line() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.03,
color = "red", size = 5,
label = str_glue("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))
# Figure 10.4 Stacked Component Contribution ggplot ----
rolling_comp_contrib_tbl %>%
# Transform data to long form
pivot_longer(cols = -date, names_to = "asset", values_to = "contribution") %>%
# Plot
ggplot(aes(date, contribution, fill = asset)) +
geom_area() +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
scale_y_continuous(labels = scales::percent_format()) +
annotate(geom = "text",
x = as.Date("2016-07-01"),
y = 0.08,
color = "red", size = 5,
label = str_glue("AGG dips below zero sometimes, indicating
it reduces the portfolio volatility."))
In my portfolio the largest contributors to volatility are AAPL and AMZN with 25 percent compared to the 20 Percent from BA and DELL close behind. I do not think my portfolios risk is concreted on one asset where four out of the five have fairly close volatility where none are extremly risky but do have have a risk factor like any stock you invest in.