Week 13: APPLY to 12
CHAPTER 4 Standard deviation
Dante Moretti
2023-10-24
# Load packages
# Core
library(tidyverse)
library(tidyquant)Goal
Collect individual returns into a portfolio by assigning a weight to each stock
five stocks: “SPY”, “EFA”, “IJS”, “EEM”, “AGG”
from 2012-12-31 to 2017-12-31
1 Import stock prices
# Choose stocks
symbols <- c("SPY", "NVDA", "VOOG")
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
# 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## NVDA SPY VOOG
## 2013-01-31 0.000000000 4.992292e-02 0.038811913
## 2013-02-28 0.038221506 1.267843e-02 0.013684145
## 2013-03-28 0.013338819 3.726775e-02 0.036022473
## 2013-04-30 0.070706298 1.902983e-02 0.020153744
## 2013-05-31 0.054651626 2.333541e-02 0.023270658
## 2013-06-28 -0.030166954 -1.343428e-02 -0.012170438
## 2013-07-31 0.028091515 5.038596e-02 0.045696870
## 2013-08-30 0.026270389 -3.045128e-02 -0.025301780
## 2013-09-30 0.053460790 3.115632e-02 0.037832770
## 2013-10-31 -0.024066526 4.526626e-02 0.048116877
## 2013-11-29 0.032034821 2.920683e-02 0.031223342
## 2013-12-31 0.026566937 2.559657e-02 0.025195432
## 2014-01-31 -0.020177274 -3.588461e-02 -0.031263374
## 2014-02-28 0.162107825 4.450994e-02 0.052536188
## 2014-03-31 -0.025904089 8.261574e-03 -0.007359012
## 2014-04-30 0.030788241 6.927491e-03 0.002124220
## 2014-05-30 0.032887008 2.294116e-02 0.033275851
## 2014-06-30 -0.024508740 2.043463e-02 0.020101537
## 2014-07-31 -0.057729720 -1.352865e-02 -0.011111220
## 2014-08-29 0.110059929 3.870473e-02 0.041663820
## 2014-09-30 -0.052782925 -1.389231e-02 -0.010203317
## 2014-10-31 0.057399652 2.327749e-02 0.027404873
## 2014-11-28 0.074852282 2.710158e-02 0.028847655
## 2014-12-31 -0.044863324 -2.539448e-03 -0.008780301
## 2015-01-30 -0.043319091 -3.007719e-02 -0.015823372
## 2015-02-27 0.142698676 5.468158e-02 0.056961048
## 2015-03-31 -0.052582529 -1.582996e-02 -0.016311371
## 2015-04-30 0.058908951 9.785752e-03 0.005079036
## 2015-05-29 0.001459541 1.277413e-02 0.016810440
## 2015-06-30 -0.095716776 -2.052108e-02 -0.018594295
## 2015-07-31 -0.007987663 2.233752e-02 0.035510098
## 2015-08-31 0.123595431 -6.288631e-02 -0.063020579
## 2015-09-30 0.092150825 -2.584730e-02 -0.023387229
## 2015-10-30 0.140555181 8.163498e-02 0.090076092
## 2015-11-30 0.115405072 3.648527e-03 0.001322673
## 2015-12-31 0.038347107 -1.743350e-02 -0.015990650
## 2016-01-29 -0.118048221 -5.106873e-02 -0.052622738
## 2016-02-29 0.071923739 -8.263926e-04 -0.007646603
## 2016-03-31 0.127655035 6.510029e-02 0.065813296
## 2016-04-29 -0.002810655 3.933328e-03 -0.013650305
## 2016-05-31 0.276388236 1.686846e-02 0.026358075
## 2016-06-30 0.006187893 3.469967e-03 -0.002744256
## 2016-07-29 0.194444005 3.582192e-02 0.044825688
## 2016-08-31 0.073468891 1.196872e-03 -0.003201750
## 2016-09-30 0.110693457 5.807728e-05 0.003915213
## 2016-10-31 0.037805387 -1.748900e-02 -0.021576005
## 2016-11-30 0.260525363 3.617600e-02 0.012742525
## 2016-12-30 0.146435772 2.006885e-02 0.013979014
## 2017-01-31 0.022601845 1.773658e-02 0.027807048
## 2017-02-28 -0.071874729 3.853920e-02 0.040910876
## 2017-03-31 0.070843719 1.249362e-03 0.012463307
## 2017-04-28 -0.043434167 9.876989e-03 0.018700138
## 2017-05-31 0.326022575 1.401435e-02 0.027773929
## 2017-06-30 0.001453480 6.354690e-03 -0.003875260
## 2017-07-31 0.117044900 2.034581e-02 0.025643223
## 2017-08-31 0.042639322 2.913451e-03 0.013402114
## 2017-09-29 0.053601230 1.994936e-02 0.011761801
## 2017-10-31 0.145700453 2.329051e-02 0.032260731
## 2017-11-30 -0.029244986 3.010806e-02 0.027234449
## 2017-12-29 -0.036583578 1.205500e-02 0.006403561# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix## NVDA SPY VOOG
## NVDA 0.0077584843 0.0008229303 0.0009094514
## SPY 0.0008229303 0.0007408261 0.0007400105
## VOOG 0.0009094514 0.0007400105 0.0007965389# 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, .50)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio## [,1]
## [1,] 0.03529268# 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## NVDA SPY VOOG
## [1,] 0.01841798 0.005390242 0.01148446rowSums(component_contribution)## [1] 0.03529268# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
component_percentages## # A tibble: 1 × 3
## NVDA SPY VOOG
## <dbl> <dbl> <dbl>
## 1 0.522 0.153 0.325component_percentages %>%
as_tibble() %>%
gather(key = "asset", value = "contribution")## # A tibble: 3 × 2
## asset contribution
## <chr> <dbl>
## 1 NVDA 0.522
## 2 SPY 0.153
## 3 VOOG 0.3254 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## NVDA SPY VOOG
## 2013-01-31 0.000000000 4.992292e-02 0.038811913
## 2013-02-28 0.038221506 1.267843e-02 0.013684145
## 2013-03-28 0.013338819 3.726775e-02 0.036022473
## 2013-04-30 0.070706298 1.902983e-02 0.020153744
## 2013-05-31 0.054651626 2.333541e-02 0.023270658
## 2013-06-28 -0.030166954 -1.343428e-02 -0.012170438
## 2013-07-31 0.028091515 5.038596e-02 0.045696870
## 2013-08-30 0.026270389 -3.045128e-02 -0.025301780
## 2013-09-30 0.053460790 3.115632e-02 0.037832770
## 2013-10-31 -0.024066526 4.526626e-02 0.048116877
## 2013-11-29 0.032034821 2.920683e-02 0.031223342
## 2013-12-31 0.026566937 2.559657e-02 0.025195432
## 2014-01-31 -0.020177274 -3.588461e-02 -0.031263374
## 2014-02-28 0.162107825 4.450994e-02 0.052536188
## 2014-03-31 -0.025904089 8.261574e-03 -0.007359012
## 2014-04-30 0.030788241 6.927491e-03 0.002124220
## 2014-05-30 0.032887008 2.294116e-02 0.033275851
## 2014-06-30 -0.024508740 2.043463e-02 0.020101537
## 2014-07-31 -0.057729720 -1.352865e-02 -0.011111220
## 2014-08-29 0.110059929 3.870473e-02 0.041663820
## 2014-09-30 -0.052782925 -1.389231e-02 -0.010203317
## 2014-10-31 0.057399652 2.327749e-02 0.027404873
## 2014-11-28 0.074852282 2.710158e-02 0.028847655
## 2014-12-31 -0.044863324 -2.539448e-03 -0.008780301
## 2015-01-30 -0.043319091 -3.007719e-02 -0.015823372
## 2015-02-27 0.142698676 5.468158e-02 0.056961048
## 2015-03-31 -0.052582529 -1.582996e-02 -0.016311371
## 2015-04-30 0.058908951 9.785752e-03 0.005079036
## 2015-05-29 0.001459541 1.277413e-02 0.016810440
## 2015-06-30 -0.095716776 -2.052108e-02 -0.018594295
## 2015-07-31 -0.007987663 2.233752e-02 0.035510098
## 2015-08-31 0.123595431 -6.288631e-02 -0.063020579
## 2015-09-30 0.092150825 -2.584730e-02 -0.023387229
## 2015-10-30 0.140555181 8.163498e-02 0.090076092
## 2015-11-30 0.115405072 3.648527e-03 0.001322673
## 2015-12-31 0.038347107 -1.743350e-02 -0.015990650
## 2016-01-29 -0.118048221 -5.106873e-02 -0.052622738
## 2016-02-29 0.071923739 -8.263926e-04 -0.007646603
## 2016-03-31 0.127655035 6.510029e-02 0.065813296
## 2016-04-29 -0.002810655 3.933328e-03 -0.013650305
## 2016-05-31 0.276388236 1.686846e-02 0.026358075
## 2016-06-30 0.006187893 3.469967e-03 -0.002744256
## 2016-07-29 0.194444005 3.582192e-02 0.044825688
## 2016-08-31 0.073468891 1.196872e-03 -0.003201750
## 2016-09-30 0.110693457 5.807728e-05 0.003915213
## 2016-10-31 0.037805387 -1.748900e-02 -0.021576005
## 2016-11-30 0.260525363 3.617600e-02 0.012742525
## 2016-12-30 0.146435772 2.006885e-02 0.013979014
## 2017-01-31 0.022601845 1.773658e-02 0.027807048
## 2017-02-28 -0.071874729 3.853920e-02 0.040910876
## 2017-03-31 0.070843719 1.249362e-03 0.012463307
## 2017-04-28 -0.043434167 9.876989e-03 0.018700138
## 2017-05-31 0.326022575 1.401435e-02 0.027773929
## 2017-06-30 0.001453480 6.354690e-03 -0.003875260
## 2017-07-31 0.117044900 2.034581e-02 0.025643223
## 2017-08-31 0.042639322 2.913451e-03 0.013402114
## 2017-09-29 0.053601230 1.994936e-02 0.011761801
## 2017-10-31 0.145700453 2.329051e-02 0.032260731
## 2017-11-30 -0.029244986 3.010806e-02 0.027234449
## 2017-12-29 -0.036583578 1.205500e-02 0.006403561cal_component_contribution <- function(.data, w) {
# Covariance of asset returns
covariance_matrix <- cov(asset_returns_wide_tbl)
covariance_matrix
# 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, .50)
sd_portfolio <- sqrt(t(w) %*% covariance_matrix %*% w)
sd_portfolio
# 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
rowSums(component_contribution)
# Component contribution in percentage
component_percentages <- (component_contribution / sd_portfolio[1,1]) %>%
round(3) %>%
as_tibble()
return(component_percentages)
}
asset_returns_wide_tbl %>% cal_component_contribution(w = c(.25, .25, .2, .2, .1))## # A tibble: 1 × 3
## NVDA SPY VOOG
## <dbl> <dbl> <dbl>
## 1 0.522 0.153 0.3255 Visualizing Component Contribution
plot_data <- asset_returns_wide_tbl %>%
cal_component_contribution(w = c(.25, .25, .5)) %>%
#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")
6 Column Chart of Component Contribution and Weight
plot_data <- asset_returns_wide_tbl %>%
cal_component_contribution(w = c(.25, .25, .5)) %>%
#Transform to long form
pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>%
#Add weights
add_column(weight = c(.25, .25, .5)) %>%
#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? NVDA as the other stocks are spy stocks and have very little volatility.