# Load packages

# Core
library(tidyverse)
library(tidyquant)

Goal

Measure which portfolio is expected to yield a higher return adjusted for risk using the Sharpe Ratio. The Sharpe Ratio is the mean of the excess portfolio returns (returns - risk free rate) divided by the standard deviation of the excess returns.

five stocks: “SPY”, “EFA”, “IJS”, “EEM”, “AGG”

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

1 Import stock prices

symbols <- c("META", "TSLA", "CMG", "NVDA", "SPY")

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] "CMG"  "META" "NVDA" "SPY"  "TSLA"
# weights
weights <- c(0.25, 0.25, 0.2, 0.2, 0.1)
weights
## [1] 0.25 0.25 0.20 0.20 0.10
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
##   symbols weights
##   <chr>     <dbl>
## 1 CMG        0.25
## 2 META       0.25
## 3 NVDA       0.2 
## 4 SPY        0.2 
## 5 TSLA       0.1

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.0660 
##  2 2013-02-28 -0.0215 
##  3 2013-03-28  0.00980
##  4 2013-04-30  0.101  
##  5 2013-05-31  0.0406 
##  6 2013-06-28  0.00834
##  7 2013-07-31  0.167  
##  8 2013-08-30  0.0484 
##  9 2013-09-30  0.0917 
## 10 2013-10-31  0.0367 
## # … with 50 more rows

5 Calculate Sharpe Ratio

# Risk free rate
rfr <- 0.0003

portfolio_sharpe_tbl <- portfolio_returns_tbl %>%

    tq_performance(Ra = returns,
                   Rf = rfr,
                   performance_fun = SharpeRatio,
                   FUN = "StdDev") 

portfolio_sharpe_tbl
## # A tibble: 1 × 1
##   `StdDevSharpe(Rf=0%,p=95%)`
##                         <dbl>
## 1                       0.527

6 Plot

Returns Histogram with Risk-Free Rate

# Figure 7.2 Returns Histogram with Risk-Free Rate ggplot ----

portfolio_returns_tbl %>%

    ggplot(aes(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, size = 5) +
    labs(y = "count")

Scatter Returns around Risk Free Rate

# Figure 7.1 Scatter Returns around Risk Free Rate ----

portfolio_returns_tbl %>%

    # Transform data
    mutate(returns_excess = if_else(returns > rfr, "above_rfr", "below_rfr")) %>%

    ggplot(aes(date, returns, color = returns_excess)) +
    geom_point(show.legend = FALSE) +

    # risk free rate
    geom_hline(yintercept = rfr, linetype = "dotted", size = 1, color = "cornflowerblue") +

    # election date
    geom_vline(xintercept = as.Date("2016-11-30"), size = 1, color = "cornflowerblue") +

    # formatting
    scale_x_date(breaks = scales::pretty_breaks(n = 7)) +

    # labeling
    annotate(geom = "text",
             x = as.Date("2017-01-01"), y = -0.04,
             label = "Election", angle = 90, size = 5) +
    annotate(geom = "text",
             x = as.Date("2017-06-01"), y = -0.01,
             label = str_glue("No returns below the RFR
                              after the 2016 election"),
             color = "red", size = 4) +
    labs(y = "percent monthly returns",
         x = NULL)

Rolling Sharpe

# Custom function
# necessary because we would not be able to specify FUN = "StdDev" otherwise

calculate_rolling_sharpeRatio <- function(df) {

    SharpeRatio(df,
                Rf = rfr,
                FUN = "StdDev")

}

# dump(list = "calculate_rolling_sharpeRatio",
#      file = "00_scripts/calculate_rolling_sharpeRatio.R")

# Set the length of periods for rolling calculation
window <- 24

# Calculate rolling sharpe ratios
rolling_sharpe_tbl <- portfolio_returns_tbl %>%

    tq_mutate(select = returns,
              mutate_fun = rollapply,
              width = window,
              align = "right",
              FUN = calculate_rolling_sharpeRatio,
              col_rename = "sharpeRatio") %>%
    na.omit()

rolling_sharpe_tbl
## # A tibble: 37 × 3
##    date         returns sharpeRatio
##    <date>         <dbl>       <dbl>
##  1 2014-12-31 -0.0102         0.697
##  2 2015-01-30 -0.0213         0.615
##  3 2015-02-27  0.0329         0.675
##  4 2015-03-31 -0.0165         0.643
##  5 2015-04-30  0.00956        0.590
##  6 2015-05-29  0.0122         0.566
##  7 2015-06-30 -0.000877       0.556
##  8 2015-07-31  0.0761         0.577
##  9 2015-08-31 -0.0181         0.503
## 10 2015-09-30  0.0179         0.460
## # … with 27 more rows
# Figure 7.5 Rolling Sharpe ggplot ----

rolling_sharpe_tbl %>%

    ggplot(aes(date, sharpeRatio)) +
    geom_line(color = "cornflowerblue") +

    labs(title = paste0("Rolling ", window, "-Month Sharpe Ratio"),
         y = "rolling Sharpe Ratio",
         x = NULL) +
    theme(plot.title = element_text(hjust = 0.5)) +

    annotate(geom = "text",
             x = as.Date("2016-06-01"), y = 0.5,
             label = "",
             size = 5, color = "red")

# The structural break seems to be taking place right at the end of 2015 and beginning of 2016 February area. The portfolio over time is down from its peak in 2015 but is slowly making a steady recovery towards its highs and is sitting right at .45 Sharpe ratio. I think the reason for the structural break was somewhat because of January 2016, crude oil falling below $27 a barrel, the DJIA closed down 249 points after falling 565 points resulting in us landing in bear market territory. Inflation was also higher than expected and fell below the Federal reserves target right as the year was coming to a close making it fall in line with the structural break of the portfolio and sharpe ratio chart.