# Load packages

# Core
library(tidyverse)
library(tidyquant)

Goal

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

Choose your stocks.

from 2012-12-31 to present

1 Import stock prices

symbols <- c("MSFT", "DPZ", "AAPL")

prices <- tq_get(x = symbols,
                 get = "stock.prices",
                 from = "2020-12-31",
                 to = "2025-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] "AAPL" "DPZ"  "MSFT"
#weights
weights <- c(0.34, 0.33, 0.33)
weights
## [1] 0.34 0.33 0.33
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 3 × 2
##   symbols weights
##   <chr>     <dbl>
## 1 AAPL       0.34
## 2 DPZ        0.33
## 3 MSFT       0.33

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: 54 × 2
##    date         returns
##    <date>         <dbl>
##  1 2021-01-29  0.000869
##  2 2021-02-26 -0.0492  
##  3 2021-03-31  0.0278  
##  4 2021-04-30  0.0928  
##  5 2021-05-28 -0.0166  
##  6 2021-06-30  0.0890  
##  7 2021-07-30  0.0773  
##  8 2021-08-31  0.0284  
##  9 2021-09-30 -0.0725  
## 10 2021-10-29  0.0812  
## # ℹ 44 more rows

5 Compute 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.141

6 Plot: Rolling Sharpe Ratio

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("2020-12-31"),
               color = "cornflowerblue", size = 1, alpha = 0.5) +
    
    theme(legend.position = "none") +
    
    annotate(geom = "text",
             x = as.Date("2021-01-31"), y = -0.04,
             label = "Election", size = 5, angle = 90) +
    
    annotate(geom = "text",
             x = as.Date("2022-01-31"), y = -0.02,
             label = str_glue("There is no point in which 
                                No returns below RFR."),
             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 data: 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: 31 × 2
##    date       rolling_sr
##    <date>          <dbl>
##  1 2022-12-30   -0.00366
##  2 2023-01-31    0.0254 
##  3 2023-02-28    0.0252 
##  4 2023-03-31    0.0756 
##  5 2023-04-28    0.0369 
##  6 2023-05-31    0.0504 
##  7 2023-06-30    0.0528 
##  8 2023-07-31    0.0403 
##  9 2023-08-31    0.00814
## 10 2023-09-29    0.0206 
## # ℹ 21 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("2024-01-01"), y = 0.5,
             label = "This portfolio has done quite well since 2024.",
             color = "red", size = 5)

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? Looking at the portfolio over the set period it has preformed relatively well but is seeing some declines in recent times. The main structural breaks that are present is largely at late 2023 most likely october, mid 2024 likely june or august. But I would say the most relevant is 2025’s dip which was largely caused in March from the announcement of Trump Administration tariff’s causing the market to plummet rather significantly.