2026/06/05
今回はポートフォリオ・ソートによるCAPMの実証的検証と,Fama-Frenchの3ファクター・モデルを扱う.新しく登場する関数を確認しておこう.
| 関数 | パッケージ | 役割 |
|---|---|---|
ntile() |
dplyr |
データを\(n\)等分のグループに振り分ける |
table() |
base R | クロス集計表を作成する |
geom_col() |
ggplot2 |
棒グラフを描画する |
geom_hline() |
ggplot2 |
グラフに水平線を追加する |
bind_rows() |
dplyr |
複数のデータフレームを縦に結合する |
everything() |
tidyselect |
残りの全列を選択する(列の並び替えに使用) |
lm(),tidy(),full_join(),filter(),mutate(),group_by(),summarize(),lag()なども引き続き使用する.目標
ch05_output1.csvと年次データch05_output1.csvの読み込みlagged_MEを追加すると共に,年度ごとにME_rank10という変数名で十分位に振り分け1から10までを割り振るために,dplyrのntile()関数を用いてME_rank10という変数を作成している.ntile()関数は,最初の引数としてグループ分けしたいデータ(ここではlagged_ME)を取り,その次の引数にグループの数(ここでは10)を取る.
ntile()関数の返り値は自然数型となるので,上のコードではfactor()関数によりそれをファクター型に変更している.
1 2 3 4 5 6 7 8 9 10
2015 0 0 0 0 0 0 0 0 0 0
2016 125 124 124 124 124 124 124 124 124 124
2017 127 127 127 127 127 127 127 127 127 127
2018 127 127 127 127 127 127 127 127 126 126
2019 131 131 131 131 130 130 130 130 130 130
2020 133 133 132 132 132 132 132 132 132 132
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),
.groups = "drop") # 各グループで月次超過リターンの平均値を計算
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}\)に関して以下の仮定を置こう.
\[ \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 = 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 = 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モデルではうまく説明できることが分かる.annual_data,ME_sorted_portfolio,binded_CAPM_results,binded_FF3_resultsをそのまま使用する.set.seed()関数の引数には,自分の学籍番号の下4桁を入力すること.ntile() と table() によるポートフォリオ・ソート問題
my_n分位で同様のソートを行え.具体的には,annual_dataに対してgroup_by(year)した上で,ntile(lagged_ME, my_n)を用いてME_rank列を追加せよ.table()関数を使い,my_year年度における各ポートフォリオの企業数を確認せよ.各グループにほぼ均等に企業が振り分けられているか,一文で答えよ.問題
binded_CAPM_resultsから,準備で生成したmy_rank番目のポートフォリオの推定結果をfilter()で抽出し,CAPMアルファ(\(\hat{\alpha}_P\))の推定値,\(t\)値,\(p\)値を報告せよ.問題
binded_FF3_resultsから,Q2と同じmy_rank番目のポートフォリオの推定結果を抽出し,FF3アルファ(\(\hat{\alpha}_P^{\mathit{FF3}}\))の推定値,\(t\)値,\(p\)値を報告せよ.問題
binded_FF3_resultsから,my_rank番目のポートフォリオにおける\(\hat{\beta}_P^{\mathit{SMB}}\)(SMBの係数)と\(\hat{\beta}_P^{\mathit{HML}}\)(HMLの係数)の推定値をそれぞれ報告せよ.my_rank番目のポートフォリオの\(\hat{\beta}_P^{\mathit{SMB}}\)はこの解釈と整合的か,一文で答えよ.my_rankが1(最小時価総額)の場合と10(最大時価総額)の場合で\(\hat{\beta}_P^{\mathit{SMB}}\)の符号を比較し,両者の違いを報告せよ.その上で,時価総額が小さい企業で構成されるポートフォリオであっても,必ずしも\(\hat{\beta}_P^{\mathit{SMB}}\)が大きくなるとは限らない理由を一文で考えよ.(ヒント!)
2025 経営データ分析(会計)