# 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.

1 Import stock prices

symbols <- c("TGT", "AMZN", "WMT")

prices <- tq_get(x    = symbols,
                 get  = "stock.prices",    
                 from = "2012-12-31",
                 to   = "2017-12-31")

2 Convert prices to returns (monthly)

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 Calculate Component Contribution to Portfolio Volatility

 # 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
##                     AMZN           TGT           WMT
## 2013-01-31  0.0566799640  0.0207401724  0.0248962261
## 2013-02-28 -0.0046435329  0.0470676759  0.0117957058
## 2013-03-28  0.0083654117  0.0836038050  0.0620731719
## 2013-04-30 -0.0487507638  0.0303596329  0.0378938536
## 2013-05-31  0.0588686422 -0.0099608417 -0.0317801122
## 2013-06-28  0.0310507858 -0.0092516232 -0.0046876779
## 2013-07-31  0.0813355112  0.0341194972  0.0452744477
## 2013-08-30 -0.0695574024 -0.1118619385 -0.0596999987
## 2013-09-30  0.1067688764  0.0105274064  0.0133390270
## 2013-10-31  0.1521839130  0.0125809352  0.0370291267
## 2013-11-29  0.0781496951 -0.0069134387  0.0540195013
## 2013-12-31  0.0130490358 -0.0103775065 -0.0232523102
## 2014-01-31 -0.1059765070 -0.1106958899 -0.0523039537
## 2014-02-28  0.0094619111  0.1066822226  0.0002676867
## 2014-03-31 -0.0737086127 -0.0329976488  0.0293259879
## 2014-04-30 -0.1007565625  0.0202854097  0.0420200145
## 2014-05-30  0.0273092148 -0.0769023925 -0.0314092168
## 2014-06-30  0.0383835737  0.0207489052 -0.0223926634
## 2014-07-31 -0.0369767889  0.0279071533 -0.0200480052
## 2014-08-29  0.0799468534  0.0169973529  0.0323255576
## 2014-09-30 -0.0502010221  0.0425318999  0.0127662565
## 2014-10-31 -0.0540982353 -0.0138153223 -0.0026191009
## 2014-11-28  0.1031187000  0.1874997503  0.1378162824
## 2014-12-31 -0.0872368443  0.0254837530 -0.0135740681
## 2015-01-30  0.1330922758 -0.0307677021 -0.0105349843
## 2015-02-27  0.0697991955  0.0496017479 -0.0124329049
## 2015-03-31 -0.0214295288  0.0659776380 -0.0142310230
## 2015-04-30  0.1253212631 -0.0402789613 -0.0524135973
## 2015-05-29  0.0175090073  0.0128400528 -0.0433516042
## 2015-06-30  0.0112589801  0.0287065662 -0.0460135815
## 2015-07-31  0.2111621241  0.0026914764  0.0146950384
## 2015-08-31 -0.0443525737 -0.0448219640 -0.0993582583
## 2015-09-30 -0.0019516780  0.0121509649  0.0016977023
## 2015-10-30  0.2010808557 -0.0189943965 -0.1246695358
## 2015-11-30  0.0602956898 -0.0547337892  0.0275689514
## 2015-12-31  0.0165439780  0.0015160975  0.0492990734
## 2016-01-29 -0.1410054619 -0.0026205460  0.0793143962
## 2016-02-29 -0.0605352242  0.0882424944 -0.0003013189
## 2016-03-31  0.0717834457  0.0476669499  0.0392703808
## 2016-04-29  0.1053453885 -0.0343709521 -0.0239372474
## 2016-05-31  0.0915002937 -0.1372354518  0.0641211185
## 2016-06-30 -0.0099694796  0.0150074351  0.0311568075
## 2016-07-29  0.0586021200  0.0759579782 -0.0006848540
## 2016-08-31  0.0135476463 -0.0627264885 -0.0143680453
## 2016-09-30  0.0848953859 -0.0217479586  0.0094732379
## 2016-10-31 -0.0583892995  0.0007277707 -0.0295507208
## 2016-11-30 -0.0509721788  0.1251765272  0.0058387059
## 2016-12-30 -0.0009330597 -0.0670619565 -0.0116432809
## 2017-01-31  0.0936394046 -0.1135002949 -0.0350399089
## 2017-02-28  0.0258446771 -0.0835534649  0.0608894911
## 2017-03-31  0.0479423059 -0.0628498135  0.0234084990
## 2017-04-28  0.0424566809  0.0118877187  0.0421089740
## 2017-05-31  0.0725778079 -0.0018017411  0.0511561498
## 2017-06-30 -0.0271286060 -0.0532516424 -0.0378583193
## 2017-07-31  0.0202278723  0.0804398588  0.0553880375
## 2017-08-31 -0.0072953921 -0.0272904973 -0.0180251554
## 2017-09-29 -0.0198260414  0.0789560716  0.0008959218
## 2017-10-31  0.1395154081  0.0005083000  0.1109629406
## 2017-11-30  0.0626577388  0.0247792014  0.1076144956
## 2017-12-29 -0.0062057977  0.0855496425  0.0207683404
calculate_component_contribution <- function(.data, w) {
    
         # Covariance of asset returns
        covariance_matrix <- cov(asset_returns_wide_tbl)
        
        # 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()
        
        return(component_percentages)
}

asset_returns_wide_tbl %>% calculate_component_contribution(w = c(.2, .1, .05))
## # A tibble: 1 × 3
##    AMZN   TGT   WMT
##   <dbl> <dbl> <dbl>
## 1 0.808  0.14 0.052

6 Plot: Colum Chart of Component Contribution and Weight

plot_data <- asset_returns_wide_tbl %>%
    
    calculate_component_contribution(w = c(.2, .1, .05)) %>%
    
    #Transform to long form
    pivot_longer(cols = everything(), names_to = "Asset", values_to = "Contribution") %>%

#Add weights
    add_column(weight = c(.2, .1, .05)) %>%
    
#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?

Amazon is the largest asset in my portfolio that is the largest contributor to the portfolio’s volatility. Based off of the chart Amazon is the asset that is most concentreted on with the risk with the contribution being a little over 80% and the weight being 20% compared to Target and Walmarts contribution being under 20% in contribution and 10% and under in weight.