アセットアロケーションをRとplot.lyを使って検証する

plot.lyでリスクとリターンを分析する

下の例はVTI, VWO, TLT, IYR, IAUという、米国株、新興国株、長期債権、不動産投資信託、金に投資するETFを組み合わせた時の各銘柄の割合とリターン/リスクをプロットしたグラフです。2010年以降のデータを使っています。

plot.lyというサービスを使っています。plotly入門 というサイトを参考に描画してみました。
横軸がリスク（=標準偏差)、縦軸がリターン（=平均変化率)です。左に行くほどリスクを抑え、上に行くほどリターンが高くなるバランスになることを示しています。
インタラクティブなグラフは便利で各プロットの上にカーソルを持ってくると年次リターン(%)とリスク（標準偏差）に加えて、そのポートフォリオ内の各銘柄のウェイトも分かります。
シャープレシオが最大になるのはこのグラフで最も左上に位置する点です。シャープレシオを高める他、リスクを高めずにリターンを高めるには、上の方の点を見ればいいし、リターンを変えずにリスクを低くするには左の方の点を見ればいいわけです。

仮想のポートフォリオを検証

Rを使うとここからさらにいろんなことができます。プロットから仮にVTI 47.5%, VWO 5%, TLT 37.5%, IYR 2.5%, IAU 7.5%のポートフォリオを作ってみたいと思えば、月次のリターンや1ドルの投資がどれくらいに成長するかも簡単にグラフ化する（参照：Reproducible Finance with R: The Sharpe Ratio | R-bloggers,
Annualized Standard Deviation of Monthly / Quarterly Return ）ことができます。

また、そのポートフォリオが様々な組み合わせの中でどの程度のリターンとリスクが有るかも視覚的に表示する事ができます。
このポートフォリオは2010年以降のデータからはリスクを抑え、高いリターンであることが分かります。

シャープレシオが最大になるポートフォリオ

ちなみに、様々な組み合わせの中で今回最もシャープレシオ（期待リターン/標準偏差）が高くなる組み合わせはVTI 47.5%, VWO 5%, TLT 42.5%, IYR 2.5%, IAU 2.5%のようです。

このグラフはRがあれば結構簡単に作れるので、気になる銘柄があってポートフォリオを作ってバックテストをするのに役に立ちそうです。
ちなみに、各銘柄は2.5%刻みでアセットアロケーションが設定されるようになっていますが設定次第でも1%刻みでも5%刻みにでもなります。
ただ、バックテストの弱点はその銘柄が設定された以降のデータしか取得できないことで、同じものを分析しようにも1980年からのデータが欲しくても自動取得ではできないのが難点です。なので例えば今回の2010年以降のデータからはリーマンショックなどは織り込まれませんので必然的に株式にオーバーウェイトする傾向などが出てきてしまうと思います。
もっとも、外からデータを取ってくることができればかなり長期の分析などもできるので同じ要領でレイ・ダリオのオールシーズンとかも検証できるし、以前取り上げたレバレッジドETFのアセットアロケーションも計算ができました。また、JPMAM(https://www.jpmorganasset.co.jp/jpec/ja/promotion/ltcma2018/matrices.html)の公開データの期待リターンとリスクから同じようなグラフを作成することもできました。記事の長さの問題からこれは次回以降に気が向いたら掲載します。

おまけ（ソース公開）

以下におまけみたいなものですが、作り方を掲載してみます。

読み込むパッケージは以下のものです。インストールしていなければinstall.packagesをやってみてください。

library(PerformanceAnalytics)
library(quantmod)
library(dygraphs)
library(dplyr)
library(foreach)
library(ggplot2)
library(stringr)
library(plotly)

自分で設定するのは銘柄と解析を開始する年度だけでOKです。
“VTI”とか銘柄が描いてある所に好きな銘柄を入れてください　※まだ米国株のみの対応です。。

#ポートフォリオの銘柄と開始年度を設定
portfolio <- c('VTI', 'VWO', 'TLT', 'IYR', 'IAU')
year <- 2010

銘柄の情報を取得して、それぞれの月次リターンを表示します

#月次リターンを求める関数
monthly_stock_returns <- function(ticker, start_year) {
symbol <- getSymbols(ticker, src = 'yahoo', auto.assign = FALSE, warnings = FALSE)
data <- periodReturn(symbol, period = 'monthly', subset=paste(start_year, "::", sep = ""), type = 'log')
colnames(data) <- as.character(ticker)
assign("temp", data, .GlobalEnv)
}
#ポートフォリオの銘柄全ての情報を取得
stocklist <- as.list(NA)
for(i in 1:length(portfolio)){
monthly_stock_returns(portfolio[i], year)
stocklist[[i]] <- temp
}
# それぞれリターンを描画
merged_returns <- Reduce(cbind,lapply(stocklist, merge.xts))
dygraph(merged_returns, main = "Monthly Return") %>%
dyAxis("y", label = "%") %>%
dyOptions(colors = RColorBrewer::brewer.pal(3, "Set2"))

適当に1000個くらいのポートフォリオをシミュレーションして作成してみて、それぞれについてリターンやリスク・シャープレシオを計算したデータを作成する。
※それぞれの銘柄割合の最小パーセンテージは2.5%としています。

#ランダムに1000個のポートフォリオを作って比較する
genweight = function(merged_returns)
{
random <- floor(runif(ncol(merged_returns)-1, min=0, max=41)) * 2.5
sort <- order(random)
random <- random[sort]
random <- c(0, random, 100)
w <- diff(random)
(w <- w/sum(w))
}
w <- foreach(i = 1:1000) %do% genweight(merged_returns)
temp <- NULL
sr <- lapply(w, function(i) {
portfolio_monthly_returns <- Return.portfolio(merged_returns, weights = i, rebalance_on = "quarters")
portfolio_annual_returns <- Return.annualized(portfolio_monthly_returns)
temp[1] <- as.numeric(StdDev(portfolio_monthly_returns) * sqrt(12) * 100)
temp[2] <- as.numeric(portfolio_annual_returns) * 100
sharpe_ratio_manual <- round(temp[2]/temp[1], 4)
temp[3] <- sharpe_ratio_manual[1]
temp
})

あとはデータを描画用にちょこっと整形します。
plot.lyの描画はインタラクティブなグラフができるので、冒頭のようなグラフが簡単に描けます。

plotdata <- as.data.frame(Reduce(rbind, sr))
rownames(plotdata) <- NULL
colnames(plotdata) <- c("StdDev", "Return", "SharpeRatio")
plot_weight <- as.data.frame(Reduce(rbind,w))
rownames(plot_weight) <- NULL
colnames(plot_weight) <- portfolio
plot_weight <- apply(plot_weight, 1, str_c,  collapse = ", ")
plotdata_p <- cbind(plotdata, plot_weight)
pf_tickers <- str_c(portfolio, collapse = ", ")
p <- plot_ly(
plotdata_p, x = ~StdDev, y = ~Return,
# Hover text:
text = ~paste(pf_tickers, "\n" ,plot_weight)) %>%
layout(title = "Annualized Portfolio Return and Risk")
p

Webサービスを利用してWebで見たければplot.lyに登録して以下のコードを描けばWebで見れるようになります。

# Create a shareable link to your chart
# Set up API credentials: https://plot.ly/r/getting-started
Sys.setenv("plotly_username"="IDを入力")
Sys.setenv("plotly_api_key"="API KEYを入力")
api_create(p, filename = "ファイル名")

任意のポートフォリオをテストして、plotlyのグラフに追加でプロットしてみます。

#テストのポートフォリオのアロケーションを設定
test_portfolio <- c(.475, .05, .375, .025, .075)
# ポートフォリオの月時リターン計算
portfolio_monthly_returns <- Return.portfolio(merged_returns, weights = test_portfolio)
dygraph(portfolio_monthly_returns, main = "Portfolio Monthly Return") %>%
dyAxis("y", label = "%")
# 1ドル投資した時の推移を描画
dollar_growth <- Return.portfolio(merged_returns, weights = test_portfolio, wealth.index = TRUE)
dygraph(dollar_growth, main = "Growth of $1 Invested in Portfolio") %>%
dyAxis("y", label = "$")
# 年次リターンに変換してプロット
portfolio_monthly_returns <- Return.portfolio(merged_returns, weights = test_portfolio, rebalance_on = "quarters")
portfolio_annual_returns <- Return.annualized(portfolio_monthly_returns)
test_retrisk <- data.frame(StdDev = NA, Return = NA, SharpeRatio = NA)
test_retrisk$StdDev <- as.numeric(StdDev(portfolio_monthly_returns) * sqrt(12) * 100)
test_retrisk$Return <- as.numeric(portfolio_annual_returns) * 100
test_retrisk$SharpeRatio <- round(test_portfolio[1]/test_portfolio[2], 4)
test_retrisk$plot_weight <- str_c(test_portfolio, collapse = ", ")
plotdata_p$Label <- "Data"
test_retrisk$Label <- "Test"
plotdata_p2 <- bind_rows(plotdata_p, test_retrisk)
p <- plot_ly(
plotdata_p2, x = ~StdDev, y = ~Return, color = ~Label, colors = c("light green", "orange"),
# Hover text:
text = ~paste(pf_tickers, "\n" ,plot_weight)) %>%
layout(title = "Annualized Portfolio Return and Risk")
p

とりあえず最大のシャープレシオになるポートフォリオを作りたい！というのであれば以下のようにすると得られます。

i <- min(which(plotdata$SharpeRatio == max(plotdata$SharpeRatio)))
plotdata$SharpeRatio[i]
w[[i]]
portfolio_monthly_returns <- Return.portfolio(merged_returns, weights = w[[i]])
dygraph(portfolio_monthly_returns, main = "Portfolio Monthly Return") %>%
dyAxis("y", label = "%")
dollar_growth <- Return.portfolio(merged_returns, weights = w[[i]], wealth.index = TRUE)
dygraph(dollar_growth, main = "Growth of $1 Invested in Portfolio") %>%
dyAxis("y", label = "$")