Apply it to your data 8
How has your portfolio’s downside risk changed over time?
Cameron Whitty
# Load packages
# Core
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.2
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(tidyquant)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## ── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.11 ──
## ✔ PerformanceAnalytics 2.0.8 ✔ TTR 0.24.4
## ✔ quantmod 0.4.28 ✔ xts 0.14.1── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ dplyr::filter() masks stats::filter()
## ✖ xts::first() masks dplyr::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ xts::last() masks dplyr::last()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggrepel)Goal
Visualize and examine changes in the underlying trend in the downside risk of your portfolio in terms of kurtosis.
Choose your stocks.
I chose the stocks NVDA, AMD, INTC, AVGO and TSM. These stocks all have to do with computer technology.
from 2012-12-31 to present
1 Import stock prices
symbols <- c("NVDA", "AMD", "INTC", "AVGO", "TSM")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2025-11-10")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] "AMD" "AVGO" "INTC" "NVDA" "TSM"# weights
weights <- c(0.25, 0.25, 0.2, 0.2, 0.1)
weights## [1] 0.25 0.25 0.20 0.20 0.10w_tbl <- tibble(symbols, weights)
w_tbl## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 AMD 0.25
## 2 AVGO 0.25
## 3 INTC 0.2
## 4 NVDA 0.2
## 5 TSM 0.14 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")## Warning in check_weights(weights, assets_col, map, x): Sum of weights does not
## equal 1.portfolio_returns_tbl## # A tibble: 155 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0580
## 2 2013-02-28 -0.0108
## 3 2013-03-28 0.0251
## 4 2013-04-30 0.0390
## 5 2013-05-31 0.142
## 6 2013-06-28 -0.00420
## 7 2013-07-31 -0.0312
## 8 2013-08-30 -0.0307
## 9 2013-09-30 0.0892
## 10 2013-10-31 -0.00316
## # ℹ 145 more rows5 Calculate Skewness
portfolio_returns_tbl %>%
tq_performance(Ra = returns,
Rb = NULL,
performance_fun = table.Stats) %>%
select(Kurtosis)## # A tibble: 1 × 1
## Kurtosis
## <dbl>
## 1 0.6416 Plot
Distribution of portfolio returns
portfolio_returns_tbl %>%
ggplot(aes(returns)) +
geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Expected Return vs Risk
# Figure 6.3 Asset and Portfolio Kurtosis Comparison ----
asset_returns_kurtosis_tbl <- asset_returns_tbl %>%
# kurtosis for each asset
group_by(asset) %>%
summarise(kt = kurtosis(returns),
mean = mean(returns)) %>%
ungroup() %>%
# kurtosis of portfolio
add_row(tibble(asset = "Portfolio",
kt = kurtosis(portfolio_returns_tbl$returns),
mean = mean(portfolio_returns_tbl$returns)))
asset_returns_kurtosis_tbl %>%
ggplot(aes(kt, mean)) +
geom_point() +
# Formatting
scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
theme(legend.position = "none") +
# Add label
ggrepel::geom_text_repel(aes(label = asset, color = asset), size = 5) +
labs(y = "Expected Return",
x = "Kurtosis")
Rolling kurtosis
# 3 Rolling kurtosis ----
# Assign a value to winder
window <- 24
port_rolling_kurtosis_tbl <- portfolio_returns_tbl %>%
tq_mutate(select = returns,
mutate_fun = rollapply,
width = window,
FUN = kurtosis,
col_rename = "rolling_kurtosis") %>%
select(date, rolling_kurtosis) %>%
na.omit()
# Figure 6.5 Rolling kurtosis ggplot ----
port_rolling_kurtosis_tbl %>%
ggplot(aes(date, rolling_kurtosis)) +
geom_line(color = "cornflowerblue") +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
scale_x_date(breaks = scales::breaks_pretty(n = 7)) +
labs(title = paste0("Rolling ", window, "-Month Kurtosis"),
x = NULL,
y = "kurtosis") +
theme(plot.title = element_text(hjust = 0.5)) +
annotate(geom = "text",
x = as.Date("2016-12-01"), y = 3,
color = "red", size = 5,
label = str_glue("The risk level skyrocketed at the end of the period
with the 24-month kurtosis rising above three."))
Has the downside risk of your portfolio increased or decreased over time? Explain using the plot you created. You may also refer to the skewness of the returns distribution you plotted in the previous assignment.
It has gone down overall. The rolling kurtosis surged during 2019–2020 and then steadily fell afterward. This trend makes sense given how many businesses were hit in 2020 and experienced declines in value over time. The return distribution had a skewness of 0.641, which indicates a modest tendency toward occasional positive returns.