2025/01/15
目標
ch05_output1.csv
と年次データch05_output1.csv
の読み込みlagged_ME
を追加すると共に,年度ごとにME_rank10
という変数名で十分位に振り分け1
から10
までを割り振るために,dplyr
のntile()
関数を用いてME_rank10
という変数を作成している.ntile()
関数は,最初の引数としてグループ分けしたいデータ(ここではlagged_ME
)を取り,その次の引数にグループの数(ここでは10
)を取る.
ntile()
関数の返り値は整数型 (int
)となるので,上のコードではas.factor()
関数によりそれをファクター型に変更している.full_join()
関数を用いてmonthly_data
と結合year
とfirm_ID
をキーにしてmonthly_data
と結合すると共に,drop_na()
関数により欠損データを除いている.\[ R_{P,t}^{e} = \frac{1}{N} R_{1,t}^{e} + \frac{1}{N} R_{2,t}^{e} + \cdots + \frac{1}{N} R_{N,t}^{e} = \frac{\sum_{j = 1}^{N} R_{j,t}^{e}}{N} \]
ME_sorted_portfolio
と名付けようME_sorted_portfolio <- annual_data %>%
select(year, firm_ID, ME_rank10) %>% # 年次データから追加したい情報を抽出
full_join(monthly_data, by = c("year", "firm_ID")) %>% # yearとfirm_IDをキーに月次データと結合
drop_na() %>% # 欠損行を削除
group_by(month_ID, ME_rank10) %>% # month_IDとME_rank10に関してグループ化
summarize(Re = mean(Re)) %>% # 各グループで月次超過リターンの平均値を計算
ungroup()
head(ME_sorted_portfolio)
ME_sorted_portfolio %>%
group_by(ME_rank10) %>% # ME_rank10に関してグループ化
summarize(mean_Re = mean(Re)) %>% # 月次超過リターンの平均値を計算
ggplot() +
geom_col(aes(x = ME_rank10, y = mean_Re)) + # 棒グラフを描くにはgeom_col()関数を用いる
labs(x = "ME Rank", y = "Mean Monthly Excess Return") +
scale_y_continuous(expand = c(0, 0)) +
theme_classic()
ME_rank10
が小さい企業ほど,マーケット・ベータが高いので,平均的に超過リターンが高い傾向にある.\[ \begin{align*} \underbrace{\mathbb{E}\left[R_i\right]-R_F}_{\textbf{証券$i$のリスクプレミアム}} & =\underbrace{\beta_i}_{\textbf{証券$i$のマーケット・ベータ}}\underbrace{\left(\mathbb{E}\left[R_M\right]-R_F\right)}_{\textbf{市場リスクプレミアム}}\\ \text{ただし,}\quad \beta_i & =\frac{{\rm Cov}[R_i,\ R_M]}{{\rm Var}[R_M]} \end{align*} \]
\[ \begin{align} \underbrace{R_{i,t}}_{\textbf{証券$i$の実現リターン}} - \underbrace{R_{F,t}}_{\textbf{無リスク金利}} & = \beta_i(\underbrace{R_{M,t}}_{\substack{\textbf{市場ポートフォリオの} \\ \textbf{実現リターン}}} - \underbrace{R_{F,t}}_{\textbf{無リスク金利}}) +\varepsilon_{i,t}\nonumber\\ \underbrace{R_{i,t}^e}_{\textbf{証券$i$の実現超過リターン}} & = \beta_i\underbrace{R_{M,t}^e}_{\substack{\textbf{市場ポートフォリオの} \\ \textbf{実現超過リターン}}} +\varepsilon_{i,t} \label{eq:CAPM1} \tag{6.1} \end{align} \]
ここで,\(\varepsilon_{i,t}\)に関して以下の仮定を置こう.\(\mathbb{E}\)
\[ \begin{align} R_{P,t}^e=\underbrace{\alpha_{P}}_{\substack{\textbf{CAPMが成立} \\ \textbf{すればゼロ}}} + \beta_{P}R_{M,t}^e+\varepsilon_{P,t} \label{eq:CAPM2} \tag{6.2} \end{align} \]
ME_Rank10
が1
のポートフォリオのみを対象とした検証まずは下準備として,市場ポートフォリオの超過リターンが収録されたch06_output.csv
をfactor_data
として読み込み,month_ID
をキーにME_sorted_portfolio
と結合し,市場ポートフォリオの超過リターンR_Me
を追加したのが以下のコードである.
# ファクター・データの読み込み
factor_data <- read_csv("../simulation_data/ch06_output.csv")
# 市場ポートフォリオの超過リターンを追加
ME_sorted_portfolio <- factor_data %>%
select(-R_F) %>% # 無リスク金利は重複するので結合前に削除
full_join(ME_sorted_portfolio, by = "month_ID") %>% # month_IDをキーに
select(-R_Me, R_Me) # R_Meを最終列へ移動
head(ME_sorted_portfolio)
ME_rank10
が1
)のデータのみを抽出して,(\(\ref{eq:CAPM2}\))式を推定してみよう.これ時系列回帰 (time-series regression)といって,個々の銘柄やポートフォリオの実現リターンが市場ポートフォリオのリターンによってどの程度説明できるかを回帰したモデルである.R_Me
の回帰係数として0.654
と推定されており,このポートフォリオが市場ポートフォリオと正に相関していることが確認できる.(Intercept)
の0.0121
であり,対応する\(t\)値は3.00
と表示されている,したがって,CAPMアルファがゼロと等しいという帰無仮説は,有意水準1%で棄却されるため,少なくともこのデータにおいてはCAPMが成立していない可能性が高いと言える.for
文を用いた全ポートフォリオの推定目標
for
文を用いて,全てのポートフォリオについて同様の推定を行ってみよう.CAPM_results
はリストであり,推定結果を閲覧するにはその各要素にアクセスする必要がある.異なるポートフォリオ間で推定結果を比較するには,各データフレームを一つのデータフレームに統合する方が便利である.それを実現するには,dplyr
のbind_rows()
関数を用いる.今回のように二つ以上のデータフレームを一つに結合したい場合に重宝する.# 推定結果を保存するために空のリストを準備
CAPM_results <- list(NA)
for(i in 1:10){
CAPM_results[[i]] <- ME_sorted_portfolio %>%
filter(ME_rank10 == i) %>%
lm(Re ~ R_Me, data = .) %>%
tidy() %>%
mutate(ME_rank10 = as.factor(i)) %>% # 推定対象のポートフォリオ名を保存
select(ME_rank10, everything()) # ME_rank10を第一列に移動
}
# 複数のデータフレームを一つに統合
binded_CAPM_results <- bind_rows(CAPM_results)
head(binded_CAPM_results)
filter()
関数により抽出し,棒グラフにより各十分位ポートフォリオのCAPMアルファを描画してみよう.binded_CAPM_results %>%
filter(term == "(Intercept)") %>% # 定数項に関する推定結果のみを抽出
ggplot() +
geom_col(aes(x = ME_rank10, y = estimate)) + # 横軸をME_rank10, 縦軸をCAPM_alphaとする棒グラフ
geom_hline(yintercept = 0) +
labs(x = "ME Rank", y = "CAPM alpha") +
scale_y_continuous(limits = c(-0.003, 0.013)) +
theme_classic()
CAPM_alph
が高いということが分かる.特に時価総額が最も小さいポートフォリオのCAPMアルファは1.21%で,年率に換算すると14.52% (\(=1.21% \times 12\))にもなる.線形ファクター・モデルとは?
任意の証券の無リスク金利に対する超過リターンが,ファクターと呼ばれる\(K\)個の確率変数\(F^k\) (\(k = 1, 2, \ldots, K\)),及び誤差項\(\varepsilon_{i}\)の線形結合で記述できるというモデルである. \[ \begin{align*} R_{i,t}^e = \beta_i^1 F_t^1+\beta_i^2 F_t^2+\cdots + \beta_i^K F_t^K + \varepsilon_{i,t} \end{align*} \]
ただし,誤差項\(\varepsilon_{i}\)は\(\mathbb{E}[\varepsilon_{i}]=0\),かつ\({\rm Cov}[\varepsilon_{i}, F^k]=0\)を満たす.ここで,\(\beta_i^k\)はファクター・ローディング (factor loading)と呼ばれ,証券\(i\)のリターンとファクター\(F^k\)との共変動の強さを表すパラメータであり,説明変数を一つから複数へと増やした重回帰分析によって推定することができる.ただし,通常の回帰分析と異なり,定数項を除いている点がポイントである.
目標
# 推定結果を保存するために空のリストを準備
FF3_results <- list(NA)
# ポートフォリオごとにFF3アルファの推定
for(i in 1:10) {
FF3_results[[i]] <- ME_sorted_portfolio %>%
filter(ME_rank10 == i) %>%
lm(Re ~ R_Me + SMB + HML, data = .) %>% # 3ファクターの実現値を独立変数として重回帰
tidy() %>%
mutate(ME_rank10 = as.factor(i)) %>% # 推定対象のポートフォリオ名を保存
select(ME_rank10, everything()) # ME_rank10を第一列に移動
}
# 複数のデータフレームから構成されるリストを一つのデータフレームに統合
binded_FF3_results <- bind_rows(FF3_results)
CAPM_alpha
を図示した要領で,ポートフォリオごとにFF3アルファを描画してみよう.binded_FF3_results
から各ポートフォリオの定数項\(\hat{\alpha}_P^{\mathit{FF3}}\)を抽出した後,それを棒グラフで可視化している.FF3_alpha
のグラフを見てみると,いずれのポートフォリオもアルファにほとんど差がないことが分かる.CAPM_alpha
のそれと対照的であり,CAPMが説明できなかった平均超過リターンの違いを,FF3モデルではうまく説明できることが分かる.Financial Accounting