# Load packages

# Core
library(tidyverse)
library(tidyquant)

Goal

Measure portfolio risk using kurtosis. It describes the fatness of the tails in probability distributions. In other words, it measures whether a distribution has more or less returns in its tails than the normal distribution. It matters to investors because a distribution with excess kurtosis (kurtosis > 3) means our portfolio might be at risk of a rare but huge downside event. Kurtosis less than 3 means the portfolio is less risky because it has fewer returns in the tails.

five stocks: “AMZN”, “INTC”, “TSLA”, “GME”, “AAPL”

from 2012-12-31 to 2017-12-31

1 Import stock prices

symbols <- c("LULU", "NFLX", "TSLA")

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 Assign a weight to each asset

# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "LULU" "NFLX" "TSLA"
# weights
weights <- c(0.30, 0.35, 0.35)
weights
## [1] 0.30 0.35 0.35
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 3 × 2
##   symbols weights
##   <chr>     <dbl>
## 1 LULU       0.3 
## 2 NFLX       0.35
## 3 TSLA       0.35

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.209  
##  2 2013-02-28  0.0108 
##  3 2013-03-28  0.00990
##  4 2013-04-30  0.230  
##  5 2013-05-31  0.230  
##  6 2013-06-28 -0.0432 
##  7 2013-07-31  0.148  
##  8 2013-08-30  0.138  
##  9 2013-09-30  0.0866 
## 10 2013-10-31 -0.0688 
## # … with 50 more rows

5 Calculate Sharpe Ratio

# Define risk free rate
rfr <- 0.0003

portfolio_SharpeRatio_tbl <- portfolio_returns_tbl %>%
    
    tq_performance(Ra = returns, 
                   performance_fun = SharpeRatio,
                   Rf              =  rfr,
                   FUN             =  "StdDev")
portfolio_SharpeRatio_tbl
## # A tibble: 1 × 1
##   `StdDevSharpe(Rf=0%,p=95%)`
##                         <dbl>
## 1                       0.348

6 Plot

Histogram of Returns with risk free rate

portfolio_returns_tbl %>%
    
    ggplot(aes(x = returns)) + 
    geom_histogram(binwidth = 0.01, fill = "cornflowerblue", alpha = 0.5) +
    
    geom_vline(xintercept = rfr, color = "green", size = 1) + 
    
    annotate(geom = "text", 
                x = rfr, + 0.002,
                y = 13,
                label = "risk free rate",
                angle = 90 ) +
    labs(y = "count")

Scatterplot of Returns around Risk Free Rate

portfolio_returns_tbl %>%
    
    # Add a new variable 
    mutate(excess_returns = if_else(returns > rfr, "rfr_above",
                                                    "rfr_below")) %>%
    # Plot
    ggplot(aes(x = date, y = returns)) +
    geom_point(aes(color = excess_returns)) +
    geom_hline(yintercept = rfr, color = "cornflowerblue", 
               linetype = 3, size = 1) +
    geom_vline(xintercept = as.Date("2016-11-01"), 
               color = "cornflowerblue", size = 1, alpha = 0.5) +
    
    theme(legend.position = "none") +
    
    annotate(geom = "text", 
             x = as.Date("2016-12-01"), y = -0.04, 
             label = "Election", size = 5, angle = 90) +
    
    annotate(geom = "text", 
             x = as.Date("2017-05-01"), y = -0.01,
             label = str_glue("No returns below RFR after the 2016 election."),
             
             color = "green") +
    
        labs(y = "monthly returns", x = NULL)

Rolling Sharpe Ratio

# Create a custom function to calculate rolling SR

Calculate_rolling_SharpeRatio <- function(data) {
    
    
    
   rolling_SR <- SharpeRatio(R = data,
                Rf = rfr,
                FUN = "StdDev")
    return(rolling_SR)
}  
# Define window
window <- 24

# Transform date: calculate rolling Sharpe ratio
rolling_sr_tbl <- portfolio_returns_tbl %>%
    
    tq_mutate(select = returns, 
              mutate_fun = rollapply,
              width = window,
              FUN = Calculate_rolling_SharpeRatio,
              col_rename = "rolling_sr") %>%
    
        select(-returns) %>%
        na.omit()
    
rolling_sr_tbl
## # A tibble: 37 × 2
##    date       rolling_sr
##    <date>          <dbl>
##  1 2014-12-31      0.413
##  2 2015-01-30      0.392
##  3 2015-02-27      0.403
##  4 2015-03-31      0.347
##  5 2015-04-30      0.335
##  6 2015-05-29      0.289
##  7 2015-06-30      0.346
##  8 2015-07-31      0.314
##  9 2015-08-31      0.245
## 10 2015-09-30      0.137
## # … with 27 more rows
rolling_sr_tbl %>%
    
    ggplot(aes(x = date, y = rolling_sr)) +
    geom_line(color = "cornflowerblue") +
    
    # Labeling
    labs(x = NULL, y = "Rolling Sharpe Ratio") +
    
    annotate(geom = "text", 
             x = as.Date("2016-06-01"), y = 0.5,
             label = "This portfolio has done quite well since 2016",
             color = "red", size = 4)

### I think that my stocks have been on the upward trend due to how down the market was since cvoid had begun. The market has been really unstable since 2020 and finally are starting to see the patterns of uprising since the pandemic is no longer a global concern. Other stocks have taken a hit because the pandemic is over as well like zoom will no longer be worth as much as it was in its peak.