# Load packages

# Core
library(tidyverse)
library(tidyquant)

1 Import stock prices

symbols <- c("LULU", "NKE","UA") 
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 Assign a weight to each asset (change the weigting scheme)

# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "LULU" "NKE"  "UA"
# weights
weights <- c(0.35, 0.45, 0.20)
weights
## [1] 0.35 0.45 0.20
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 3 × 2
##   symbols weights
##   <chr>     <dbl>
## 1 LULU       0.35
## 2 NKE        0.45
## 3 UA         0.2

4 Build a portfolio

# ?tq_portfolio
portfolio_returns_tbl <- asset_returns_tbl %>%
    
    tq_portfolio(assets_col = asset,
                 returns_col = returns,
                 weights = w_tbl, 
                 rebalance_on = "months", 
                 col_rename = "returns")
portfolio_returns_tbl
## # A tibble: 60 × 2
##    date         returns
##    <date>         <dbl>
##  1 2013-01-31 -0.0140  
##  2 2013-02-28 -0.00489 
##  3 2013-03-28  0.0107  
##  4 2013-04-30  0.104   
##  5 2013-05-31 -0.00480 
##  6 2013-06-28 -0.0458  
##  7 2013-07-31  0.0157  
##  8 2013-08-30  0.00711 
##  9 2013-09-30  0.0765  
## 10 2013-10-31 -0.000965
## # ℹ 50 more rows

5 Calculate Kurtosis

portfolio_kurt_tidyquant_builtin_percent <- portfolio_returns_tbl %>%
    tq_performance(Ra =  returns, 
               performance_fun = table.Stats) %>%
    select(Kurtosis) 
portfolio_kurt_tidyquant_builtin_percent
## # A tibble: 1 × 1
##   Kurtosis
##      <dbl>
## 1    0.497

6 Plot

portfolio_returns_tbl %>%
    ggplot(aes(x = returns)) +
    geom_histogram()

# Transform Data
mean_kurt_tbl <- asset_returns_tbl %>%
    
    # Calculate mean return and kurtosis for assets
    group_by(asset) %>%
    summarise (mean = mean(returns),
               kurt = kurtosis(returns)) %>%
    ungroup() %>%
    
    # Add portfolio stats
    add_row(portfolio_returns_tbl %>%
    summarise(mean = mean(returns),
              kurt = kurtosis(returns)) %>%
    mutate(asset= "Portfolio"))

#Plot
mean_kurt_tbl %>%
    ggplot(aes(x = kurt, y = mean)) +
    geom_point() +
    ggrepel:: geom_text_repel(aes(label = asset, color = asset)) +
    
    # Formatting
    theme(legend.position = "none") +
    scale_y_continuous(labels = scales:: percent_format(accuracy = 0.1)) + 
    # Labeling
    labs(x = "Kurtosis",
         y = "Expected Returns")

Rolling 24 Month Kurtosis

# Assign a value for window
window = 24

# Transform data: calculate 24 month rolling kurtosis
rolling_kurt_tbl <- portfolio_returns_tbl %>%
    tq_mutate (select = returns, 
               mutate_fun = rollapply,
               width = window,
               FUN = kurtosis,
               col_rename = "kurt") %>%
    na.omit() %>%
    select(-returns)
#Plot
rolling_kurt_tbl %>%
    ggplot(aes(x=date, y=kurt)) +
    geom_line(color = "cornflowerblue") +
    
    #Formatting
    scale_y_continuous(breaks = seq (-1,4, 0.5))+
    scale_x_date(breaks = scales:: pretty_breaks(n = 7)) + 
    theme(plot.title = element_text(hjust=0.5)) +

# Labeling
labs(x = NULL,
     y = "Kurtosis",
     title =paste0("Rolling", window, "Month Kurtosis")) +
    annotate(geom= "text", x = as.Date("2016-07-01"), y= 3,size = 4, color = "red", label = str_glue ("Downside risk skyrocketed toward the end of 2016"))

The downside risk of my portfolio (consisting of Lululemon, Nike, and Under Armour) saw an increased downside risk until around 2016 when the start of a very steady decreased downside risk occurred and did not change much until around August 2016 when the downside risk skyrocketed and went back to an increased value before decreasing in the middle of 2017 and continuing to fluctuate.