# Load packages
# Core
library(tidyverse)
library(tidyquant)
1 Import stock prices
symbols <- c("NKE", "GOOG", "MSFT", "TSLA", "AMZN")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")
2 Convert prices to returns
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] "AMZN" "GOOG" "MSFT" "NKE" "TSLA"
# 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 AMZN 0.25
## 2 GOOG 0.25
## 3 MSFT 0.2
## 4 NKE 0.2
## 5 TSLA 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: 60 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0556
## 2 2013-02-28 0.0125
## 3 2013-03-28 0.0301
## 4 2013-04-30 0.0767
## 5 2013-05-31 0.0943
## 6 2013-06-28 0.0241
## 7 2013-07-31 0.0261
## 8 2013-08-30 0.00515
## 9 2013-09-30 0.0769
## 10 2013-10-31 0.0805
## # … with 50 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.519
6 Plot
Returns Histogram with Risk-Free Rate
# 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: 37 × 3
## date returns sharpeRatio
## <date> <dbl> <dbl>
## 1 2014-12-31 -0.0501 0.600
## 2 2015-01-30 -0.00793 0.535
## 3 2015-02-27 0.0569 0.573
## 4 2015-03-31 -0.0261 0.501
## 5 2015-04-30 0.0780 0.502
## 6 2015-05-29 0.0124 0.452
## 7 2015-06-30 0.00424 0.430
## 8 2015-07-31 0.122 0.468
## 9 2015-08-31 -0.0396 0.412
## 10 2015-09-30 0.0183 0.372
## # … with 27 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 well since 2016. There was a dip right before the New Year in 2017, as well as right before 2018. This is most likely due to yearly earnings coming out so their stock prices drop if they're worse than expected.",
size = 5, color = "red")
