リスク最小化ポートフォリオ
Rikiya Honda
2021/5/30
library(quantmod)
library(tidyverse)
library(patchwork)
library(highcharter)
library(timetk)
library(tibbletime)
library(lubridate)
library(PerformanceAnalytics)
library(scales)Importing data
# import data
symbols <- c("AAPL", "MSFT", "AMZN", "TSLA", "FB", "GOOGL", "GOOG", "NVDA", "PYPL")
from = "2012-12-31"
to = "2021-4-30"
prices <- getSymbols(symbols,
src = "yahoo",
from = from,
to = to,
) %>%
map(~Ad(get(.))) %>%
reduce(merge) %>%
`colnames<-`(symbols)
# Transforming data
prices_monthly <- to.monthly(prices,
indexAt = "lastof",
OHLC = FALSE)
asset_return_xts <-
Return.calculate(prices_monthly,
method = "log") %>%
na.omit()
# Visualization of stocks
asset_return_xts %>%
tk_tbl(preserve_index = TRUE,
rename_index = "date") %>%
pivot_longer(cols = -date, names_to = "asset", values_to = "returns") %>%
ggplot(aes(date, returns, colour = asset)) +
geom_line() +
labs(title = "Monthy Log Returns",
x = "Date",
y = "Return")
Building a Portfolio
Efficient Frontier(1)
# ポートフォリオリスク最小化 -----------------------------------------------------------
library(fPortfolio)
# データを用意
prices_ts <- prices %>% as.timeSeries() %>% na.omit()
# 制約条件を設定
conditions <- portfolioSpec()
# プロットする点を設定
setNFrontierPoints(conditions) <- 100
#ウェイト制約を追加してみる。
#1、2番目の資産の最低保有ウェイトがそれぞれ10%,20%
#各資産の最大ウェイトが50%という意味
weightConstraints <- c("minW[1:length(symbols)]=0.01","maxW[1:length(symbols)]=0.5")
efficientFrontier <- portfolioFrontier(prices_ts, conditions)
# plot
plot.new()
for (i in c(1:3, 5, 7)) {
plot(efficientFrontier, i)
}
#接点ポートフォリオを取得
p.tan <- tangencyPortfolio(prices_ts, constraints = weightConstraints)
getWeights(p.tan)## AAPL MSFT AMZN TSLA FB GOOGL GOOG NVDA PYPL
## 0.01 0.01 0.01 0.01 0.43 0.50 0.01 0.01 0.01Efficinet Frontier(2)
Portfolio Returns
# set weights
w <- getWeights(p.tan)
# Portfolio Returns with xts
portfolio_returns_xts_rebalanced_monthly <-
Return.portfolio(asset_return_xts,
weights = w,
rebalance_on = "months") %>%
`colnames<-`("returns")Portfolio Returns chart
highchart(type = "stock") %>%
hc_title(text = "Portfolio Monthly Returns") %>%
hc_add_series(portfolio_returns_xts_rebalanced_monthly$returns,
name = "Rebalanced Monthly",
color = "cornflowerblue") %>%
hc_add_theme(hc_theme_flat()) %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE) %>%
hc_legend(enabled = TRUE) %>%
hc_exporting(enabled = TRUE)Portfolio Retruns Distribution
Rolling Volatility of Portfolio
# Portfolio standard deviation with xts
portfolio_sd_xts_builtin <-
StdDev(asset_return_xts, weights = w)
portfolio_sd_xts_builtin_percent <-
round(portfolio_sd_xts_builtin * 100, 2)
# Rolling Standard Deviation in the xts world
window <- 24
port_rolling_sd_xts <-
rollapply(portfolio_returns_xts_rebalanced_monthly,
FUN = sd,
width = window) %>%
na.omit() %>%
`colnames<-`("rolling_sd")
# Visualization Rolling Standard Deviation in the xts world
port_rolling_sd_xts_hc <-
round(port_rolling_sd_xts, 4) * 100
highchart(type = "stock") %>%
hc_title(text = "24-Month Rolling Volatility") %>%
hc_add_series(port_rolling_sd_xts_hc,
color = "cornflowerblue") %>%
hc_add_theme(hc_theme_flat()) %>%
hc_yAxis(labes = list(format = "{value}%"),
opposite = FALSE) %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE) %>%
hc_exporting(enabled = TRUE) %>%
hc_legend(enabled = TRUE)Returns vs. Standard Deviation
# Visualization of Returns and Standard deviation
asset_return_xts %>%
as_tibble() %>%
mutate(date = index(asset_return_xts)) %>%
select(date, everything()) %>%
pivot_longer(cols = -date, names_to = "asset", values_to = "returns") %>%
group_by(asset) %>%
summarise(expected_return = mean(returns),
stand_dev = sd(returns)) %>%
add_row(asset = "Portfolio",
stand_dev =
sd(portfolio_returns_xts_rebalanced_monthly),
expected_return =
mean(portfolio_returns_xts_rebalanced_monthly)) %>%
ggplot(aes(x = expected_return,
y = stand_dev)) +
geom_point(aes(colour = asset), size = 2) +
geom_text(
aes(x =
mean(portfolio_returns_xts_rebalanced_monthly) + 0.001,
y =
sd(portfolio_returns_xts_rebalanced_monthly),
label = "Portfolio")) +
scale_y_continuous(labels = function(x){paste0(x, "%")}) +
labs(title = "Expected Monthly Returns versus Risk",
x = "Standard Deviation",
y = "Expected Return") +
theme(plot.title = element_text(hjust = 0.5)) +
theme_minimal()
Other Indices
Skewness
## [1] -0.04175704
## attr(,"method")
## [1] "moment"# Rolling Skewness in the xts world
window <- 24
rolling_skew_xts <-
rollapply(portfolio_returns_xts_rebalanced_monthly,
FUN = skewness,
width = window) %>%
na.omit()
# Visualing Rolling Skewness in xts world
highchart(type = "stock") %>%
hc_title(text = "Rolling 24-Month Skewness") %>%
hc_add_series(rolling_skew_xts,
name = "Rolling skewness",
colour = "cornflowerblue") %>%
hc_yAxis(title = list(text = "skewness"),
opposite = FALSE,
max = 1,
min = -1) %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE) %>%
hc_add_theme(hc_theme_flat()) %>%
hc_exporting(enabled = TRUE)Kurtosis
## [1] -0.00537461
## attr(,"method")
## [1] "excess"# Rolling Kurtosis in the xts world
window <- 24
rolling_kurt_xts <-
rollapply(portfolio_returns_xts_rebalanced_monthly,
FUN = kurtosis,
width = window) %>%
na.omit()
kurt_roll_24 <-
rollify(kurtosis,
window = window)
highchart(type = "stock") %>%
hc_title(text = "Rolling 24-Month kurtosis") %>%
hc_add_series(rolling_kurt_xts,
name = "Rolling 24-Month kurtosis",
colour = "cornflowerblue") %>%
hc_yAxis(title = list(text = "kurtosis"),
opposite = FALSE) %>%
hc_add_theme(hc_theme_flat()) %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE) %>%
hc_exporting(enabaled = TRUE)