# Load packages

# Core
library(tidyverse)
library(tidyquant)
library(ggrepel)

Goal

Visualize and examine changes in the underlying trend in the performance of your portfolio in terms of Sharpe Ratio.

Choose your stocks.

I chose the stocks JPM, BAC, C, WFC and GS. They are all in the banking industry.

from 2012-12-31 to present

1 Import stock prices

symbols <- c("JPM", "BAC", "C", "WFC", "GS")

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

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

# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "BAC" "C"   "GS"  "JPM" "WFC"
# 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 BAC        0.25
## 2 C          0.25
## 3 GS         0.2 
## 4 JPM        0.2 
## 5 WFC        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: 155 × 2
##    date        returns
##    <date>        <dbl>
##  1 2013-01-31  0.0567 
##  2 2013-02-28  0.00884
##  3 2013-03-28  0.0292 
##  4 2013-04-30  0.0248 
##  5 2013-05-31  0.103  
##  6 2013-06-28 -0.0538 
##  7 2013-07-31  0.0863 
##  8 2013-08-30 -0.0663 
##  9 2013-09-30  0.00833
## 10 2013-10-31  0.0120 
## # ℹ 145 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.150

6 Plot: Rolling Sharpe Ratio

# 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: 132 × 3
##    date       returns sharpeRatio
##    <date>       <dbl>       <dbl>
##  1 2014-12-31  0.0277       0.409
##  2 2015-01-30 -0.133        0.178
##  3 2015-02-27  0.0880       0.232
##  4 2015-03-31 -0.0152       0.196
##  5 2015-04-30  0.0373       0.205
##  6 2015-05-29  0.0329       0.161
##  7 2015-06-30  0.0227       0.233
##  8 2015-07-31  0.0295       0.194
##  9 2015-08-31 -0.0817       0.175
## 10 2015-09-30 -0.0601       0.110
## # ℹ 122 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 = "This portfolio has done quite well since 2018.",
             size = 5, color = "red")

How has your portfolio performed over time? Provide dates of the structural breaks, if any. The Code Along Assignment 9 had one structural break in November 2016. What do you think the reason is?

The portfolio has performed extremely well over time. The only real break was during 2020, which is understandable due to quarantine. I think the structural break in November of 2016 was due to Trumps win in presidency. It took me a while to think of that, but it makes a lot more sense now.