Steps 1-4: Rebuild the Portfolio

symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")

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

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"))

symbols_vec <- asset_returns_tbl %>%
  distinct(asset) %>%
  pull()

weights <- c(0.25, 0.25, 0.20, 0.20, 0.10)

w_tbl <- tibble(symbols_vec, weights) %>%
  set_names(c("asset", "weights"))

portfolio_returns_tbl <- asset_returns_tbl %>%
  tq_portfolio(
    assets_col   = asset,
    returns_col  = returns,
    weights      = w_tbl,
    col_rename   = "returns",
    rebalance_on = "months"
  )
## Warning in check_weights(weights, assets_col, map, x): Sum of weights does not
## equal 1.

Step 5: Calculate Sharpe Ratio

The Sharpe ratio is (portfolio return - risk-free rate) divided by a risk measure. Here the risk measure is standard deviation (FUN = "StdDev"). Look up valid options with ?PerformanceAnalytics::SharpeRatio.

# Define the risk-free rate once so it only needs changing in one place
risk_free_rate <- 0.0003

portfolio_sharpe_tbl <- portfolio_returns_tbl %>%
  tq_performance(
    Ra              = returns,
    Rb              = NULL,
    performance_fun = SharpeRatio,
    Rf              = risk_free_rate,
    FUN             = "StdDev"
  )

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

A negative Sharpe ratio means the portfolio returned less than the risk-free rate; a value near zero means you’d have done about as well holding Treasuries with no risk.

Step 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 = risk_free_rate, color = "green", linewidth = 1) +
  annotate(geom = "text",
           x = risk_free_rate + 0.002, y = 13,
           label = "risk-free rate", angle = 90) +
  labs(y = "count")

Scatterplot of Returns around Risk-Free Rate

portfolio_returns_tbl %>%
  mutate(excess_returns = if_else(returns > risk_free_rate,
                                  "risk-free rate above",
                                  "risk-free rate below")) %>%
  ggplot(aes(x = date, y = returns, color = excess_returns)) +
  geom_point() +
  geom_hline(yintercept = risk_free_rate, color = "cornflowerblue",
             linetype = 3, linewidth = 1) +
  geom_vline(xintercept = as.Date("2016-11-01"), color = "cornflowerblue",
             linewidth = 1, alpha = 0.5) +
  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\nafter the 2016 election"),
           color = "green") +
  theme(legend.position = "none") +
  labs(x = "", y = "monthly returns")

Rolling 24-Month Sharpe Ratio

# Step 1: transform the data
window <- 24

# Custom function: rollapply's FUN slot is used up, so the risk measure
# (standard deviation) has to be baked into a function of our own.
calculate_rolling_sharpe_ratio <- function(data) {
  rolling_SR <- SharpeRatio(data, Rf = risk_free_rate, FUN = "StdDev")
  return(rolling_SR)
}

rolling_sharpe_ratio_table <- portfolio_returns_tbl %>%
  tq_mutate(
    select     = returns,
    mutate_fun = rollapply,
    width      = window,
    FUN        = calculate_rolling_sharpe_ratio,
    col_rename = "rolling_sharpe_ratio"
  ) %>%
  select(-returns) %>%
  na.omit()

rolling_sharpe_ratio_table
## # A tibble: 37 × 2
##    date       rolling_sharpe_ratio
##    <date>                    <dbl>
##  1 2014-12-31               0.230 
##  2 2015-01-30               0.178 
##  3 2015-02-27               0.240 
##  4 2015-03-31               0.210 
##  5 2015-04-30               0.214 
##  6 2015-05-29               0.222 
##  7 2015-06-30               0.238 
##  8 2015-07-31               0.162 
##  9 2015-08-31               0.0950
## 10 2015-09-30              -0.0279
## # ℹ 27 more rows
# Step 2: make the plot
rolling_sharpe_ratio_table %>%
  ggplot(aes(x = date, y = rolling_sharpe_ratio)) +
  geom_line(color = "cornflowerblue") +
  annotate(geom = "text", x = as.Date("2016-06-01"), y = 0.5,
           label = "This portfolio has done\nquite well since 2016",
           color = "red", size = 5) +
  labs(x = "", y = "rolling Sharpe ratio",
       title = paste0("Rolling ", window, " Month Sharpe Ratio")) +
  theme(plot.title = element_text(hjust = 0.5))