# Load packages
# Core
library(tidyverse)
library(tidyquant)
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
symbols <- c("UNH", "LLY", "JNJ", "PFE", "MRK")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2000-12-31",
to = "2025-06-11")
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
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "JNJ" "LLY" "MRK" "PFE" "UNH"
# weights
weights <- c(0.3, 0.25, 0.20, 0.13, 0.12)
weights
## [1] 0.30 0.25 0.20 0.13 0.12
w_tbl <-tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 JNJ 0.3
## 2 LLY 0.25
## 3 MRK 0.2
## 4 PFE 0.13
## 5 UNH 0.12
# ?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: 293 × 2
## date returns
## <date> <dbl>
## 1 2001-02-28 0.0181
## 2 2001-03-30 -0.0633
## 3 2001-04-30 0.0746
## 4 2001-05-31 -0.0211
## 5 2001-06-29 -0.0516
## 6 2001-07-31 0.0677
## 7 2001-08-31 -0.0268
## 8 2001-09-28 0.0323
## 9 2001-10-31 -0.00428
## 10 2001-11-30 0.0495
## # ℹ 283 more rows
# 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.148
# 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)
}
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: 270 × 2
## date rolling_sr
## <date> <dbl>
## 1 2003-01-31 -0.0708
## 2 2003-02-28 -0.120
## 3 2003-03-31 -0.0129
## 4 2003-04-30 -0.0541
## 5 2003-05-30 -0.0596
## 6 2003-06-30 0.0402
## 7 2003-07-31 -0.0492
## 8 2003-08-29 -0.0570
## 9 2003-09-30 -0.109
## 10 2003-10-31 -0.0925
## # ℹ 260 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("2015-06-01"), y = 0,
label = str_glue(""),
color = "red", size = 4)