# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(scales)
library(ggrepel)
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("AMGN", "T", "BA", "CAT", "IBM")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2022-11-03")
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 <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "AMGN" "BA" "CAT" "IBM" "T"
#Weights
weights <- c(0.15, 0.50, 0.05, 0.1, 0.2)
weights
## [1] 0.15 0.50 0.05 0.10 0.20
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 AMGN 0.15
## 2 BA 0.5
## 3 CAT 0.05
## 4 IBM 0.1
## 5 T 0.2
# 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: 119 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.00894
## 2 2013-02-28 0.0369
## 3 2013-03-28 0.0793
## 4 2013-04-30 0.0350
## 5 2013-05-31 0.0280
## 6 2013-06-28 0.00605
## 7 2013-07-31 0.0320
## 8 2013-08-30 -0.0167
## 9 2013-09-30 0.0675
## 10 2013-10-31 0.0722
## # … with 109 more rows
# Define rfr
rfr <- .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.0933
# Create 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: 96 × 2
## date rolling_sr
## <date> <dbl>
## 1 2014-12-31 0.516
## 2 2015-01-30 0.550
## 3 2015-02-27 0.556
## 4 2015-03-31 0.466
## 5 2015-04-30 0.424
## 6 2015-05-29 0.371
## 7 2015-06-30 0.349
## 8 2015-07-31 0.353
## 9 2015-08-31 0.220
## 10 2015-09-30 0.119
## # … with 86 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("2016-6-01"), y = .7, label = "This portfolio has
been quite volitile.", color = "red", size = 4)
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?
There seems to have been a structural break around March of the year 2020. This might have been due to the Coronavirus outbreak in the United States. The structural break in code along assignment 9 might have been due to the upcoming presidential election at the time. Overall, the portfolio has been highly volatile over the time frame being measured. Shortly after 2018, the portfolio peaked and had a fairly good return compared to the risk being assumed. In the last couple of years the portfolio hasn’t performed very well at all however.