# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(readr)
# Time series
library(lubridate)
library(tibbletime)
# modeling
library(broom)
Examine how each asset contributes to portfolio standard deviation. This is to ensure that our risk is not concentrated in any one asset.
Import your stocks from 2012-12-31 to present.
symbols <- c("AAPL", "CL=F", "ROKU", "BTC-USD", "NFLX")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2023-10-31")
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 BTC-USD CL=F NFLX ROKU
## 2013-01-31 -1.555890e-01 NA 0.059919651 0.5792178072 NA
## 2013-02-28 -2.561110e-02 NA -0.057417846 0.1294683790 NA
## 2013-03-28 2.850421e-03 NA 0.054747400 0.0063600708 NA
## 2013-04-30 2.709385e-04 NA -0.039545813 0.1323750202 NA
## 2013-05-31 2.217175e-02 NA -0.016071077 0.0460381788 NA
## 2013-06-28 -1.258956e-01 NA 0.048702101 -0.0693560587 NA
## 2013-07-31 1.321022e-01 NA 0.084081461 0.1468488828 NA
## 2013-08-30 8.044310e-02 NA 0.024639226 0.1495238153 NA
## 2013-09-30 -2.172391e-02 NA -0.050682335 0.0853633452 NA
## 2013-10-31 9.201571e-02 NA -0.059904220 0.0420204523 NA
## 2013-11-29 6.770786e-02 NA -0.038714471 0.1260456325 NA
## 2013-12-31 8.862198e-03 NA 0.059659805 0.0064580908 NA
## 2014-01-31 -1.139491e-01 NA -0.009494230 0.1059769064 NA
## 2014-02-28 5.591799e-02 NA 0.050990640 0.0849673396 NA
## 2014-03-31 1.975673e-02 NA -0.009893743 -0.2357726219 NA
## 2014-04-30 9.476099e-02 NA -0.018279905 -0.0890406532 NA
## 2014-05-30 7.576503e-02 NA 0.029342696 0.2603988640 NA
## 2014-06-30 2.728625e-02 NA 0.025568517 0.0530627854 NA
## 2014-07-31 2.832645e-02 NA -0.070777341 -0.0414273713 NA
## 2014-08-29 7.465165e-02 NA -0.022769223 0.1221472352 NA
## 2014-09-30 -1.722065e-02 NA -0.051315184 -0.0569909207 NA
## 2014-10-31 6.948918e-02 -0.1342847888 -0.123862278 -0.1386421470 NA
## 2014-11-28 1.007303e-01 NA -0.196829053 -0.1250817171 NA
## 2014-12-31 -7.460561e-02 -0.1660946011 -0.216551584 -0.0144727330 NA
## 2015-01-30 5.961136e-02 NA -0.099184742 0.2571875124 NA
## 2015-02-27 9.601595e-02 NA 0.031022827 0.0722680160 NA
## 2015-03-31 -3.187441e-02 -0.0402833334 -0.044378686 -0.1307827695 NA
## 2015-04-30 5.770013e-03 -0.0336397917 0.225326092 0.2893246523 NA
## 2015-05-29 4.434117e-02 NA 0.011173270 0.1145793430 NA
## 2015-06-30 -3.793830e-02 0.1335226592 -0.013860087 0.0513461801 NA
## 2015-07-31 -3.348082e-02 0.0788326093 -0.232774488 0.1972314899 NA
## 2015-08-31 -6.848927e-02 -0.2129375775 0.043196122 0.0062789186 NA
## 2015-09-30 -2.205734e-02 0.0257632432 -0.087233143 -0.1079428532 NA
## 2015-10-30 8.011218e-02 NA 0.032725433 0.0483934447 NA
## 2015-11-30 -5.821062e-03 0.1831748610 -0.112084524 0.1292201596 NA
## 2015-12-31 -1.167902e-01 0.1320065902 -0.117302971 -0.0753374900 NA
## 2016-01-29 -7.822389e-02 NA -0.096877338 -0.2194783218 NA
## 2016-02-29 -1.287926e-03 0.1713618659 0.003859321 0.0169505524 NA
## 2016-03-31 1.197460e-01 -0.0490907297 0.127513324 0.0902267645 NA
## 2016-04-29 -1.507313e-01 NA 0.180406971 -0.1270822750 NA
## 2016-05-31 6.931414e-02 0.1699858750 0.066958292 0.1304025548 NA
## 2016-06-30 -4.359637e-02 0.2367572485 -0.015806480 -0.1144250835 NA
## 2016-07-29 8.623536e-02 NA -0.149952393 -0.0025174134 NA
## 2016-08-31 2.337634e-02 -0.0820506206 0.071873388 0.0657364022 NA
## 2016-09-30 6.344837e-02 0.0578338652 0.076215069 0.0112246699 NA
## 2016-10-31 4.325155e-03 0.1394435092 -0.029024141 0.2367091536 NA
## 2016-11-30 -2.183786e-02 0.0618433554 0.053595339 -0.0650992833 NA
## 2016-12-30 4.684074e-02 NA 0.083025609 0.0564934501 NA
## 2017-01-31 4.664179e-02 0.0068868229 -0.017084802 0.1280336976 NA
## 2017-02-28 1.255551e-01 0.1955328038 0.022468591 0.0100410836 NA
## 2017-03-31 4.754174e-02 -0.0961588052 -0.065217637 0.0391854826 NA
## 2017-04-28 -6.977553e-05 NA -0.025419094 0.0292677767 NA
## 2017-05-31 6.560724e-02 0.5284424458 -0.020686905 0.0689841760 NA
## 2017-06-30 -5.891565e-02 0.0816143845 -0.048334944 -0.0874853720 NA
## 2017-07-31 3.218020e-02 0.1475737108 0.085906598 0.1954425989 NA
## 2017-08-31 1.016530e-01 0.4921125957 -0.060387928 -0.0390093333 NA
## 2017-09-29 -6.213441e-02 NA 0.089848033 0.0373014045 NA
## 2017-10-31 9.240365e-02 0.3993517077 0.051119152 0.0798771971 -0.264099077
## 2017-11-30 2.007509e-02 0.4587476184 0.054047871 -0.0461006656 0.767360368
## 2017-12-29 -1.536355e-02 NA 0.051275816 0.0230816211 0.165089596
## 2018-01-31 -1.069317e-02 -0.3257126734 0.068904679 0.3422453562 -0.242743421
## 2018-02-28 6.596112e-02 0.0171497274 -0.048913824 0.0750958659 0.003685998
## 2018-03-29 -5.980419e-02 NA 0.052152804 0.0135328404 -0.270738697
## 2018-04-30 -1.513365e-02 0.2814798646 0.054391313 0.0563153192 0.045262298
## 2018-05-31 1.267420e-01 -0.2094760121 -0.022565647 0.1180177495 0.140803543
## 2018-06-29 -9.462746e-03 NA 0.100800619 0.1073124981 0.129049929
## 2018-07-31 2.759894e-02 0.1946900892 -0.075467878 -0.1483892939 0.063628895
## 2018-08-31 1.826730e-01 -0.1003485122 0.015011842 0.0857955874 0.269855763
## 2018-09-28 -8.337418e-03 NA 0.048244194 0.0173903689 0.205062040
## 2018-10-31 -3.095177e-02 -0.0475939550 -0.114733121 -0.2149050726 -0.272687125
## 2018-11-30 -1.999125e-01 -0.4527387428 -0.248692980 -0.0532520010 -0.310727334
## 2018-12-31 -1.240885e-01 -0.0707948142 -0.114719805 -0.0667287380 -0.285149515
## 2019-01-31 5.368679e-02 -0.0791769489 0.169355252 0.2377564149 0.383244453
## 2019-02-28 4.380292e-02 0.1086848930 0.061815916 0.0533383470 0.388488292
## 2019-03-29 9.260265e-02 NA 0.049771658 -0.0043097723 -0.027218786
## 2019-04-30 5.490111e-02 0.2649281308 0.060800674 0.0384589024 -0.014364056
## 2019-05-31 -1.326324e-01 0.4715605523 -0.177794187 -0.0764149871 0.351788057
## 2019-06-28 1.226770e-01 NA 0.088832169 0.0676869856 0.001989174
## 2019-07-31 7.361688e-02 -0.0700218919 0.001879550 -0.1286120899 0.131694310
## 2019-08-30 -1.659808e-02 NA -0.061243684 -0.0948922673 0.381733341
## 2019-09-30 7.042256e-02 -0.1494357148 -0.018870191 -0.0931610198 -0.397043989
## 2019-10-31 1.049765e-01 0.1036419037 0.002032345 0.0713417349 0.369175065
## 2019-11-29 7.469397e-02 NA 0.018107452 0.0905829220 0.085691430
## 2019-12-31 9.420402e-02 -0.0509525540 0.101437716 0.0279227940 -0.180390408
## 2020-01-31 5.260173e-02 0.2622413313 -0.169110805 0.0643897455 -0.101715995
## 2020-02-28 -1.218305e-01 NA -0.141431359 0.0670726963 -0.062077714
## 2020-03-31 -7.231414e-02 -0.2893870426 -0.781866068 0.0173805330 -0.261889263
## 2020-04-30 1.444237e-01 0.2962296592 -0.083466501 0.1116390480 0.326279361
## 2020-05-29 8.166695e-02 NA 0.633268737 -0.0002858456 -0.101673707
## 2020-06-30 1.374865e-01 -0.0347434838 0.101209866 0.0807736724 0.062132851
## 2020-07-31 1.528341e-01 0.2144364850 0.025145906 0.0717317246 0.284566444
## 2020-08-31 1.960348e-01 0.0310709271 0.056482196 0.0799293979 0.113347111
## 2020-09-30 -1.081715e-01 -0.0798391041 -0.057724567 -0.0573783743 0.084625976
## 2020-10-30 -6.188836e-02 NA -0.116695864 -0.0497966282 0.069557637
## 2020-11-30 9.120466e-02 0.3535563807 0.236521098 0.0309615020 0.371870229
## 2020-12-31 1.084720e-01 0.3905083045 0.067786445 0.0970870744 0.123079038
## 2021-01-29 -5.516732e-03 NA 0.073106416 -0.0155437114 0.158461283
## 2021-02-26 -8.306852e-02 NA 0.163954665 0.0120608627 0.016443786
## 2021-03-31 7.312740e-03 0.2664414105 -0.038791540 -0.0324212105 -0.193908668
## 2021-04-30 7.345295e-02 -0.0200343752 0.072053349 -0.0158244352 0.051451406
## 2021-05-28 -5.181668e-02 NA 0.042192522 -0.0209791877 0.010845688
## 2021-06-30 9.450001e-02 -0.0633596602 0.102385670 0.0492816132 0.281106053
## 2021-07-30 6.295829e-02 NA 0.006511972 -0.0203491777 -0.069747497
## 2021-08-31 4.161138e-02 0.1249582060 -0.076555403 0.0950695060 -0.195080350
## 2021-09-30 -7.046190e-02 -0.0742619618 0.091054272 0.0698019211 -0.117446081
## 2021-10-29 5.700144e-02 NA 0.107796583 0.1231245456 -0.027336962
## 2021-11-30 9.991932e-02 -0.0729425928 -0.233306293 -0.0727082022 -0.292350193
## 2021-12-31 7.160309e-02 -0.2078652934 0.127905882 -0.0634444870 0.002588783
## 2022-01-31 -1.583695e-02 -0.1850613255 0.158755737 -0.3438762168 -0.330051146
## 2022-02-28 -5.558251e-02 0.1154640378 0.082387350 -0.0794420544 -0.161891655
## 2022-03-31 5.588260e-02 0.0528781108 0.046538985 -0.0518377235 -0.107808242
## 2022-04-29 -1.021776e-01 NA 0.043037365 -0.6769150653 -0.298947719
## 2022-05-31 -5.603718e-02 -0.1708301251 0.091054796 0.0365177336 0.021300059
## 2022-06-30 -8.493683e-02 -0.4743141995 -0.080886026 -0.1213919403 -0.144398621
## 2022-07-29 1.728043e-01 NA -0.069898288 0.2516130190 -0.226069713
## 2022-08-31 -3.170529e-02 -0.1518182815 -0.096476946 -0.0059760083 0.037152317
## 2022-09-30 -1.289443e-01 -0.0313070303 -0.119165962 0.0517762908 -0.187038520
## 2022-10-31 1.039558e-01 0.0533083546 0.084859960 0.2148866613 -0.015365687
## 2022-11-30 -3.358518e-02 -0.1771385138 -0.071613013 0.0457051938 0.066685532
## 2022-12-30 -1.304192e-01 NA -0.003606756 -0.0354794590 -0.377560919
## 2023-01-31 1.048293e-01 0.3352969478 -0.017470429 0.1823328028 0.345556837
## 2023-02-28 2.291843e-02 0.0003487103 -0.023346361 -0.0939461074 0.117821720
## 2023-03-31 1.121213e-01 0.2072684129 -0.018072845 0.0699795803 0.017317071
## 2023-04-28 2.857513e-02 NA 0.014562417 -0.0460542977 -0.157829078
## 2023-05-31 4.502911e-02 -0.0725828888 -0.120113868 0.1805874132 0.034790707
## 2023-06-30 9.014230e-02 0.1130411274 0.036766242 0.1084198198 0.094372506
## 2023-07-31 1.270447e-02 -0.0417811799 0.146680733 -0.0034566451 0.408898835
## 2023-08-31 -4.330826e-02 -0.1197419963 0.022124994 -0.0121241583 -0.170241499
## 2023-09-29 -9.285934e-02 NA 0.082146883 -0.1384714676 -0.140026770
## 2023-10-30 -5.388115e-03 NA -0.098056580 0.0825167794 -0.225306226
## 2014-11-30 NA 0.1110233272 NA NA NA
## 2015-01-31 NA -0.3868905773 NA NA NA
## 2015-02-28 NA 0.1563358260 NA NA NA
## 2015-05-31 NA -0.0255409758 NA NA NA
## 2015-10-31 NA 0.2858354616 NA NA NA
## 2016-01-31 NA -0.1549379088 NA NA NA
## 2016-04-30 NA 0.0730666470 NA NA NA
## 2016-07-31 NA -0.0750047424 NA NA NA
## 2016-12-31 NA 0.2565133647 NA NA NA
## 2017-04-30 NA 0.2292102333 NA NA NA
## 2017-09-30 NA -0.0807064945 NA NA NA
## 2017-12-31 NA 0.3244904602 NA NA NA
## 2018-03-31 NA -0.3994823782 NA NA NA
## 2018-06-30 NA -0.1572025794 NA NA NA
## 2018-09-30 NA -0.0603294667 NA NA NA
## 2019-03-31 NA 0.0629888893 NA NA NA
## 2019-06-30 NA 0.2323404150 NA NA NA
## 2019-08-31 NA -0.0461592521 NA NA NA
## 2019-11-30 NA -0.1950141965 NA NA NA
## 2020-02-29 NA -0.0837278669 NA NA NA
## 2020-05-31 NA 0.0886365782 NA NA NA
## 2020-10-31 NA 0.2451813745 NA NA NA
## 2021-01-31 NA 0.1326118435 NA NA NA
## 2021-02-28 NA 0.3097523516 NA NA NA
## 2021-05-31 NA -0.4362526106 NA NA NA
## 2021-07-31 NA 0.1722155417 NA NA NA
## 2021-10-31 NA 0.3366631369 NA NA NA
## 2022-04-30 NA -0.1885074031 NA NA NA
## 2022-07-31 NA 0.1651253939 NA NA NA
## 2022-12-31 NA -0.0368453804 NA NA NA
## 2023-04-30 NA 0.0273734612 NA NA NA
## 2023-09-30 NA 0.0391904722 NA NA NA
## 2023-10-31 NA 0.2511628977 NA NA NA
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix
## AAPL BTC-USD CL=F NFLX ROKU
## AAPL NA NA NA NA NA
## BTC-USD NA NA NA NA NA
## CL=F NA NA NA NA NA
## NFLX NA NA NA NA NA
## ROKU NA NA NA NA NA
# 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 BTC-USD CL=F NFLX ROKU
## [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 `BTC-USD` `CL=F` NFLX ROKU
## <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 BTC-USD NA
## 3 CL=F NA
## 4 NFLX NA
## 5 ROKU 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 `BTC-USD` `CL=F` NFLX ROKU
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 NA NA NA NA NA
Column Chart of Component Contribution
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.25, 0.25, 0.2, 0.2, 0.1)) %>%
# Transform to long form
pivot_longer(cols = everything(), names_to = "asset", values_to = "Contribution")
plot_data %>%
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")
Column Chart of Component Contribution and weight
plot_data <- asset_returns_wide_tbl %>%
calculate_component_contribution(w = c(0.25, 0.25, 0.2, 0.2, 0.1)) %>%
# Transform to long form
pivot_longer(cols = everything(), names_to = "asset", values_to = "Contribution") %>%
# Add weights
add_column(weight = c(0.25, 0.25, 0.2, 0.2, 0.1)) %>%
# 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? Do you think your portfolio risk is concentrated
in any one asset?
I know that Roku is the asset in my portfolio that is the largest contributor to the portfolio volatility. My portfolio is most likely concentrated in Roku, but I don’t think it is concentrated in only Roku.