# Load packages
# Core
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.2.0 ✔ stringr 1.4.1
## ✔ readr 2.1.2 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
library(tidyquant)
## Loading required package: lubridate
##
## Attaching package: 'lubridate'
##
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
##
## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
##
## Attaching package: 'xts'
##
## The following objects are masked from 'package:dplyr':
##
## first, last
##
##
## Attaching package: 'PerformanceAnalytics'
##
## The following object is masked from 'package:graphics':
##
## legend
##
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
##Goal Visualize and examine changes in the underlying trend in the downside risk of your portfolio in terms of Sharpe Ratio.
Choose your stocks.
from 2012-12-31 to present
symbol <- c("BIG", "TSLA", "AMZN", "WM", "PLUG")
prices <- tq_get(x = symbol,
get = "stock.prices",
from = "2012-12-31",
to = "2022-11-30")
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"))
## asset date returns
## "asset" "date" "returns"
symbols <- asset_returns_tbl %>% distinct(symbol) %>% pull()
symbols
## [1] "AMZN" "BIG" "PLUG" "TSLA" "WM"
weight <- c(0.2,0.2,0.2,0.2,0.2)
weight
## [1] 0.2 0.2 0.2 0.2 0.2
w_tbl <- tibble(symbols, weight)
portfolio_returns_tbl <- asset_returns_tbl %>%
tq_portfolio(assets_col = symbol,
returns_col = monthly.returns,
weights = w_tbl,
rebalance_on = "months",
col_rename = "returns")
## Warning: `spread_()` was deprecated in tidyr 1.2.0.
## Please use `spread()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
rfr <- 0.0003
portfolio_SharpRatio <- portfolio_returns_tbl %>%
tq_performance(Ra = returns,
performance_fun = SharpeRatio,
Rf = rfr,
FUN = "StdDev")
portfolio_SharpRatio
## # A tibble: 1 × 1
## `StdDevSharpe(Rf=0%,p=95%)`
## <dbl>
## 1 0.203
Calculate_rolling_SharpRatio <- function(data) {
rolling_SR <- SharpeRatio(R = data,
Rf = rfr,
FUN = "StdDev")
return(rolling_SR)
}
# Define Window
window <- 24
# Transform Data: calculate Rolling Sharp Ratio
rolling_sr_tbl <- portfolio_returns_tbl %>%
tq_mutate(select = returns,
mutate_fun = rollapply,
width = window,
FUN = Calculate_rolling_SharpRatio,
col_rename = "rolling_sr") %>%
select(-returns) %>%
na.omit()
rolling_sr_tbl %>%
ggplot(aes(x = date,
y = rolling_sr)) +
geom_line(color = "cornflowerblue") +
# Labeling
labs(x = NULL, y = "Rolling Sharp Ratio") +
annotate(geom = "text",
x = as.Date("2016-06-01"),
y = 0.5,
label = "this portfolio has dropped and recovered over the years",
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? from
20215 to 2016 there was a sharp drop and has steadily been inclining
since 2016 until now