6  ファクターモデルの導入

ゴール:株式リターンの背後にある「ファクター」を理解し、Rで実際に推定できるようになる

本章の流れは大きく4ステップに分かれます。

ステップ 内容 対応節
1. 準備 市場ポートフォリオの構築とポートフォリオ・ソート 6.1
2. 検証 CAPMは現実のリターンを説明できるか(時系列回帰) 6.2
3. 拡張 Fama-French 3ファクター・モデル(SMB・HML) 6.3
4. 応用 アルファによるファンドのパフォーマンス評価 6.4

キーワード:時価総額加重ポートフォリオ・ソートCAPMアルファサイズ効果・バリュー効果SMB・HMLFF3アルファ

Note

本ノートは書籍のシミュレーション・データを模した疑似データを自前で生成するため、数値は書籍と一致しませんが、定性的な結論(小型株効果・FF3による説明)は再現されるように設計しています。

6.0.1 本章で使うパッケージと各種設定

pacman::p_load(tidyverse, broom, ggthemes, kableExtra, scales, patchwork, gghighlight, modelsummary)
# 乱数シードを固定
set.seed(2020)
# グラフのテーマを設定
mystyle <- list(
    theme_economist_white(
        base_family = "Noto Sans JP"
    ),
    scale_colour_economist(),
    theme(
        text = element_text(family = "Noto Sans JP", size = 12),
        axis.title = element_text(size = 12)
    )
)

6.1 前提知識の復習:CAPM

第2章で学んだCAPM (Capital Asset Pricing Model) の主張は二つの命題にまとめられます。

  • 第一命題:市場ポートフォリオは接点ポートフォリオと一致し、効率的フロンティア(資本市場線)上に位置する。
  • 第二命題:各証券のリスクプレミアムは、その証券のマーケット・ベータに比例する。

\begin{aligned} \underbrace{E[R_i] - R_F}_{\text{証券}i\text{のリスクプレミアム}} = \beta_i \times \underbrace{(E[R_M] - R_F)}_{\text{市場リスクプレミアム}}, \qquad \beta_i = \frac{\mathrm{Cov}[R_i, R_M]}{\mathrm{Var}[R_M]} \end{aligned}

つまり、「銘柄ごとの期待リターンの違いは、マーケット・ベータの違いだけで説明できる」というのがCAPMの世界観である。本章の前半では、この主張がデータと整合的かを検証する。

  • R_F:無リスク金利
  • R_M:市場ポートフォリオのリターン
  • 超過リターン:R^e_{i,t} = R_{i,t} - R_{F,t}(無リスク金利を上回る部分)

6.2 教材用データの準備

本ノートでは財務データと株価データの疑似データを生成します。 設計方針(本物のデータが持つ特徴を再現する):

  • 企業数1,000社、年次データは2015〜2020年、月次データは2016年1月〜2020年12月(month_ID = 13〜72)
  • 時価総額 ME は対数正規分布に従い、分布が右に大きく歪む(少数の大企業と多数の小企業)
  • 一部の企業は2016年以降に新規上場(前年末の時価総額が欠損するケースを再現)
  • 月次リターンは「真の」3ファクター構造から生成
    • 小型株ほどサイズ・ファクターへの感応度が高い
    • 高BE/ME株ほどバリュー・ファクターへの感応度が高い

こうしておくと、後の分析で「CAPMでは説明できないが、FF3モデルなら説明できるリターンの規則性」が現れるように設計されています。

6.2.1 企業特性と年次データの生成

年次データを生成します。 rlnorm()対数正規分布に従う乱数を生成する関数です。 meanlogは対数の平均、sdlogは対数の標準偏差を指定します。 rlnorm(n, meanlog, sdlog)は、右に大きく歪んだ分布を生成するのに便利です。

n_firms <- 1000 # 企業数

# 企業ごとの固有特性(時間を通じて不変と仮定)
firm_char <- tibble(
    firm_ID = 1:n_firms, # 企業ID
    size_char = rlnorm(n_firms, meanlog = 4, sdlog = 1.5), # 企業規模(右に歪んだ分布)
    beme_char = rlnorm(n_firms, meanlog = -0.3, sdlog = 0.4), # BE/MEの平均的水準
    listed_year = sample(
      c(2015, 2016, 2017), # 上場年
      n_firms,
      replace = TRUE, 
      prob = c(0.90, 0.05, 0.05)
    ) 
) |>
    mutate(
        p_size = percent_rank(size_char), # 規模の順位(0〜1)
        p_beme = percent_rank(beme_char), # BE/MEの順位(0〜1)
        beta_M = runif(n_firms, 0.5, 1.5), # マーケット・ベータ
        b_SMB  = 1.3 - 1.2 * p_size, # 小型株ほどSMBに強く連動
        b_HML  = 1.2 * p_beme - 0.2 # バリュー株ほどHMLに強く連動
    )

# 年次データ: 各年末の時価総額MEと純資産簿価BE
annual_data <- expand_grid(firm_ID = 1:n_firms, year = 2015:2020) |>
    left_join(firm_char, by = "firm_ID") |>
    filter(year >= listed_year) |> # 上場前の年のデータは存在しない
    mutate(
        ME = size_char * rlnorm(n(), meanlog = 0, sdlog = 0.3),
        BE = ME * beme_char * rlnorm(n(), meanlog = 0, sdlog = 0.2)
    ) |>
    select(year, firm_ID, ME, BE)

次に月次リターンを生成します。 月次超過リターンは、真の3ファクター構造から生成します。

R^e_{i,t} = \beta^M_i R^e_{M,t} + \beta^{SMB}_i SMB_t + \beta^{HML}_i HML_t + \varepsilon_{i,t}

# 真のファクターの月次実現値(60ヶ月)
factor_true <- tibble(
    month_ID  = 13:72, # 2016年1月〜2020年12月
    R_F       = 0.0001, # 無リスク金利(月次)
    R_Me_true = rnorm(60, mean = 0.004, sd = 0.045),
    SMB_true  = rnorm(60, mean = 0.007, sd = 0.018),
    HML_true  = rnorm(60, mean = 0.004, sd = 0.018)
)

# 月次データ: 個別銘柄のリターン
monthly_data <- expand_grid(firm_ID = 1:n_firms, month_ID = 13:72) |>
    mutate(year = 2015 + (month_ID - 1) %/% 12) |>
    left_join(firm_char, by = "firm_ID") |>
    filter(year >= listed_year) |>
    left_join(factor_true, by = "month_ID") |>
    mutate(
        Re = beta_M * R_Me_true + b_SMB * SMB_true + b_HML * HML_true +
            rnorm(n(), mean = 0, sd = 0.05), # 銘柄固有のノイズ
        R = Re + R_F # 超過リターン + 無リスク金利 = リターン
    ) |>
    select(year, month_ID, firm_ID, R, R_F, Re)

glimpse(monthly_data)
Rows: 59,424
Columns: 6
$ year     <dbl> 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2…
$ month_ID <int> 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 2…
$ firm_ID  <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
$ R        <dbl> -0.049103616, 0.021869612, -0.069560799, 0.030683620, -0.1310…
$ R_F      <dbl> 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04…
$ Re       <dbl> -0.049203616, 0.021769612, -0.069660799, 0.030583620, -0.1311…

これでテキストの annual_data(year, firm_ID, ME, BE)と monthly_data(year, month_ID, firm_ID, R, R_F, Re)に相当するデータが生成されました。 以降の分析では、この疑似データを使ってCAPMやFF3モデルの検証を行います。

6.3 ファクター構築の準備

6.3.1 市場ポートフォリオとは

市場ポートフォリオとは市場に存在する全ての危険資産を時価総額加重で保有したポートフォリオを意味します。 ここでは上場株に限定した時価総額加重インデックスを作ります。 運用ルールとして、毎年1月に年次リバランスを行い、前年末の時価総額に比例して保有比率を決める、という方針です。

w^M_{i,t} = \frac{ME^{12月}_{i,t-1}}{\sum_{j=1}^{N} ME^{12月}_{j,t-1}}

  • w^M_{i,t}:t年における銘柄iの保有比率
  • ME^{12月}_{i,t-1}:銘柄it-1年末の時価総額

ポイントは3つ。

  1. 分子は「その銘柄の前年末時価総額」、分母は「全銘柄の前年末時価総額の合計」
  2. t-1年末に保有比率を決めて、t年の1年間はその比率で運用し続ける
  3. 1年経ったら新しい時価総額で保有比率を計算し直す(リバランス)

保有比率の計算には「前年末の時価総額」が必要です。 新変数を作成するmutate()の中で.by = firm_IDlag()を使うことで、銘柄ごとに1期前の値を取得することができます。 .by=firm_IDを忘れると他社の値が混入するので注意しましょう。

annual_data <- annual_data |>
    arrange(firm_ID, year) |> # ラグを取る前に並び順を保証
    mutate(
        .by = firm_ID,
        lagged_ME = lag(ME), # 前年末の時価総額
        lagged_BE = lag(BE) # 前年末の純資産簿価(6.3節で使用)
    ) |>
    mutate( # 前年末の簿価時価比率(6.3節で使用)
        lagged_BEME = lagged_BE / lagged_ME
    ) 
# firm_ID = 1 の銘柄のデータを確認
annual_data |> filter(firm_ID == 1)
# A tibble: 6 × 7
   year firm_ID    ME    BE lagged_ME lagged_BE lagged_BEME
  <int>   <int> <dbl> <dbl>     <dbl>     <dbl>       <dbl>
1  2015       1 103.   83.9      NA        NA        NA    
2  2016       1  40.2  24.1     103.       83.9       0.811
3  2017       1 134.  145.       40.2      24.1       0.599
4  2018       1  98.9  82.0     134.      145.        1.09 
5  2019       1 107.  110.       98.9      82.0       0.829
6  2020       1  79.7  56.9     107.      110.        1.03 

各銘柄の最初の年(2015年、または上場年)は前年のデータがないため lagged_MENA になります。

6.4 保有比率 w_M の計算

年ごとにグループ化して、各銘柄の時価総額シェアを計算する。

annual_data <- annual_data |>
    mutate(
      .by = year, # 同じ年の銘柄同士でシェアを計算
      w_M = lagged_ME / sum(lagged_ME, na.rm = TRUE)
    )
  • 分子 lagged_ME:当該銘柄の前年末時価総額
  • 分母 sum(lagged_ME, na.rm = TRUE):全銘柄の合計
  • na.rm = TRUE が必要な理由:新規上場銘柄は前年末の時価総額が欠損(NA)しており、これを無視しないと合計自体が NA になってしまう

ただしこの時点では、新規上場銘柄の w_M 自体は NA のまま残っているので、 NA = その銘柄には投資しない = 保有比率 0」とするために、次のステップで置き換えます。 mutate() + replace() の組合せは「条件に合致する行だけ値を置き換える」という便利な操作を実現します。

annual_data <- annual_data |>
    mutate(
        w_M = replace(w_M, year >= 2016 & is.na(w_M), 0)
    )

replace(置き換えたい変数, 条件, 置き換え後の値) の3引数構造となっています。 ここでは「2016年以降」かつ「w_M が欠損」という条件を & で結合しています。replace() は条件に合致する行だけを置き換え、他の行はそのまま残すので、2015年の NA はそのまま残ります。

検算:各年の保有比率の合計が1になっているかを必ず確認しましょう。(投資金額の全額が過不足なく配分されている証拠)。

annual_data |>
    summarize(
        .by = year,
        weight_sum = sum(w_M) # あえて na.rm = TRUE としない
    ) 
# A tibble: 6 × 2
   year weight_sum
  <int>      <dbl>
1  2015     NA    
2  2016      1    
3  2017      1.00 
4  2018      1.000
5  2019      1    
6  2020      1    

2015年は前年の時価総額が存在しないので NA になります(想定どおり)。 あえて na.rm = TRUE を付けないことで、想定外の欠損があれば NA として検出できます。

6.5 月次データへの結合:full_join()

w_M は年次データにあるので、月次リターンと組み合わせるには結合が必要。year と firm_ID のペアをキーにする。

monthly_data <- annual_data |>
    select(year, firm_ID, w_M) |> # 必要な列だけ抽出してから
    full_join(monthly_data, by = c("year", "firm_ID")) |> # 月次データと結合
    select(-w_M, w_M) # w_M を最終列に移動

読み解きのポイント:

  1. select() で結合に必要な3列だけに絞る(不要な列まで結合しない)
  2. キーが2列の場合は by = c("year", "firm_ID") とベクトルで渡す
  3. select(-w_M, w_M) は「w_M 以外の全列」→「w_M」の順に並べる、つまり列を最後尾へ移動するイディオム

年次の w_M が、同じ年の12ヶ月分の行すべてにコピーされる形になる(1年間は同じ保有比率で運用、という設定と対応)。

6.6 市場ポートフォリオの月次リターン

市場ポートフォリオのリターンは構成銘柄リターンの加重平均、超過リターンは無リスク金利との差で計算する。

R_{M,t} = \sum_{i=1}^{N} w^M_{i,t} R_{i,t}, \qquad R^e_{M,t} = R_{M,t} - R_{F,t}

factor_data <- monthly_data |>
    filter(month_ID >= 13) |> # 2016年以降のデータを抽出
    summarize(
        .by = month_ID, # 月ごとに集計
        R_F = R_F[1], # 無リスク金利は全銘柄共通なので先頭の値を採用
        R_M = sum(w_M * R, na.rm = TRUE) # 保有比率で加重平均
    ) |>
    mutate(R_Me = R_M - R_F) # 市場ポートフォリオの超過リターン

factor_data |> head()
# A tibble: 6 × 4
  month_ID    R_F       R_M      R_Me
     <int>  <dbl>     <dbl>     <dbl>
1       13 0.0001  0.00993   0.00983 
2       14 0.0001  0.0435    0.0434  
3       15 0.0001 -0.000897 -0.000997
4       16 0.0001 -0.0169   -0.0170  
5       17 0.0001 -0.0326   -0.0327  
6       18 0.0001  0.0614    0.0613  
  • R_F[1]:その月の無リスク金利はどの銘柄でも同じ値なので、先頭の1つを取り出せばよい
  • na.rm = TRUE:上場直後でリターンが欠損する銘柄があっても加重平均が NA にならないように

6.7 市場超過リターンの分布を見る

まずはヒストグラムで分布の形を確認する。

ggplot(factor_data) +
    geom_histogram(aes(x = R_Me), bins = 30) +
    labs(x = "市場ポートフォリオの月次超過リターン", y = "頻度") +
    scale_y_continuous(expand = c(0, 0)) +
    mystyle

  • 月次リターンはおおむね0を中心に散らばるが、プラス・マイナス数%の変動が普通に起こる
  • scale_y_continuous(expand = c(0, 0)):棒とx軸の間の余白を消す(見た目の工夫)
  • theme_economist_white():雑誌エコノミスト風のテーマ

6.8 累積リターンの考え方:cumprod()

month_ID = 13の月初に1円投資してバイ・アンド・ホールドしたら資産はどう推移するか」を見るには、グロス・リターン(1 + R)の累積積を計算する。

month_ID 13 14 15
ネット・リターン R 0.0458 0.0284 -0.0580
グロス・リターン 1+R 1.0458 1.0284 0.9420
累積グロス・リターン 1.0458 1.0458×1.0284 1.0458×1.0284×0.9420

この「その時点までの積」を一発で計算するのが cumprod()(cumulative product)。prod() は最後の1個の総乗しか返さないので、毎月の推移を見たい場合は cumprod() を使う。

factor_data |>
    mutate(
        gross_R_M            = 1 + R_M, # ネット→グロスに換算
        cumulative_gross_R_M = cumprod(gross_R_M) # 累積積
    ) |>
    ggplot() +
    geom_line(aes(x = month_ID, y = cumulative_gross_R_M)) +
    labs(x = "Month ID", y = "Cumulative Gross Return") +
    mystyle

6.9 累積リターンの可視化を磨く

先ほどのグラフは「累積リターンの図」であることが一目で分かりにくい。3つの工夫を加える。

  1. 始点(元本1)を追加:運用開始直前の month_ID = 12 に値1の行を先頭に足す
  2. 元本の水準に点線:geom_hline() で y = 1 の水平線を引く
  3. y軸との余白を消す:scale_x_continuous(expand = c(0, 0))
factor_data |>
    mutate(
        gross_R_M            = 1 + R_M,
        cumulative_gross_R_M = cumprod(gross_R_M)
    ) |>
    select(month_ID, cumulative_gross_R_M) |>
    add_row(month_ID = 12, cumulative_gross_R_M = 1, .before = 1) |> # 始点(元本1)を先頭に追加
    ggplot() +
    aes(x = month_ID, y = cumulative_gross_R_M) +
    geom_line() +
    geom_hline(yintercept = 1, linetype = "dotted") + # 元本の水準を点線で表示
    labs(x = "Month ID", y = "Cumulative Gross Return") +
    scale_x_continuous(expand = c(0, 0)) +
    mystyle

書籍では rbind(c(12, 1), .) で始点を追加しているが、ここではより tidyverse らしい add_row() を使った(結果は同じ)。

6.10 6.1.2 ポートフォリオ・ソートとは

ポートフォリオ・ソート = 何らかの特性(例:時価総額)に基づいて銘柄を順位付けし、その順位でグループ分けしてポートフォリオを作る手法。実証ファイナンスで最も頻繁に使われる分析ツールの一つ。

ここでの例:前年末の時価総額で銘柄ユニバースを十等分する。

手順のイメージ:

  1. 毎年末、全銘柄を lagged_ME の小さい順に並べる
  2. 小さい方から順に10グループに分割(グループ1 = 最小、グループ10 = 最大)
  3. 各グループ内の銘柄に等加重で投資し、1年間運用
  4. 1年経ったらランクを付け直してリバランス

なぜこんなことをするのか?

  • 「時価総額とリターンに関係はあるか」という問いに、モデルを仮定せずに答えられる
  • 個別銘柄のリターンはノイズだらけだが、グループ化して平均するとノイズが相殺され、特性とリターンの関係が浮かび上がる

6.11 ntile() で十分位に分割する

ntile(データ, グループ数) は、データを小さい順に(ほぼ)等しい人数のグループに分けて番号を返す。

annual_data <- annual_data |>
    group_by(year) |> # 年ごとに順位付けをやり直す
    mutate(ME_rank10 = as.factor(ntile(lagged_ME, 10))) |>
    ungroup()
  • group_by(year):ランク付けは毎年やり直す(去年の大型株が今年も大型株とは限らない)
  • as.factor():ランクは大小関係のある数値ではなくカテゴリーとして扱いたいのでファクター型へ変換
  • lagged_MENA の銘柄(新規上場)はランクも NA になる

思惑どおり等分できたか、各グループの企業数を確認する。

annual_data |>
    select(year, firm_ID, ME_rank10) |>
    drop_na() |>
    count(year, ME_rank10, name = "N") |> # グループごとの行数をカウント
    slice_head(n = 12)
# A tibble: 12 × 3
    year ME_rank10     N
   <int> <fct>     <int>
 1  2016 1            91
 2  2016 2            91
 3  2016 3            91
 4  2016 4            91
 5  2016 5            91
 6  2016 6            91
 7  2016 7            91
 8  2016 8            91
 9  2016 9            91
10  2016 10           90
11  2017 1            96
12  2017 2            96

各年とも1〜10のグループにほぼ同数の企業が割り当てられている(端数による±1の誤差は無視してよい)。

6.12 十分位ポートフォリオの月次リターン

月次データと結合し、各月 × 各ランクで超過リターンの平均を取る。等加重を想定しているので mean() でよい。

ME_sorted_portfolio <- annual_data |>
    select(year, firm_ID, ME_rank10) |> # 追加したい情報だけ抽出
    full_join(monthly_data, by = c("year", "firm_ID")) |> # 月次データと結合
    drop_na() |> # ランクが欠損する行などを削除
    group_by(month_ID, ME_rank10) |>
    summarize(Re = mean(Re), .groups = "drop") # 等加重 = 単純平均

ME_sorted_portfolio
# A tibble: 600 × 3
   month_ID ME_rank10        Re
      <int> <fct>         <dbl>
 1       13 1         -0.00936 
 2       13 2          0.00977 
 3       13 3         -0.00173 
 4       13 4          0.00184 
 5       13 5          0.00280 
 6       13 6          0.00798 
 7       13 7          0.00826 
 8       13 8         -0.000778
 9       13 9          0.0149  
10       13 10         0.00681 
# ℹ 590 more rows

これで「60ヶ月 × 10ポートフォリオ」の超過リターンのパネルが完成。市場ポートフォリオを作ったときとまったく同じ流れ(年次情報を select → join → グループ化して集計)であることに注目。

6.13 サイズ効果:小型株ほどリターンが高い

各ポートフォリオの平均超過リターンを棒グラフにする。

ME_cross_sectional_return <- ME_sorted_portfolio |>
    group_by(ME_rank10) |>
    summarize(mean_Re = mean(Re))

ggplot(ME_cross_sectional_return) +
    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()

小型株(ランク1)ほど平均超過リターンが高いという単調な傾向がはっきり現れる。

ここで生まれる疑問:これは「小型株はリスク(ベータ)が高いから当然の報酬」なのか、それとも「CAPMでは説明できない異常なリターン」なのか?→ 6.2節でCAPMを使って検証する。

6.14 コラム:等加重 vs 時価総額加重

ポートフォリオのリターン計算には二つの流儀がある。

  • 等加重:全銘柄に同額投資 → summarize(Re = mean(Re))
  • 時価総額加重:大きい銘柄に多く投資 → mutate(w = lagged_ME / sum(lagged_ME)) してから summarize(Re = sum(w * Re))

BE/MEに基づく十分位ソートで両者を比較してみる。

annual_data |>
    group_by(year) |>
    mutate(BEME_rank10 = as.factor(ntile(lagged_BEME, 10))) |>
    ungroup() |>
    select(year, firm_ID, BEME_rank10, lagged_ME) |>
    full_join(monthly_data, by = c("year", "firm_ID")) |>
    drop_na() |>
    group_by(month_ID, BEME_rank10) |>
    mutate(w = lagged_ME / sum(lagged_ME)) |> # ポートフォリオ内の時価総額シェア
    summarize(
        `Equal-Weighted` = mean(Re), # 等加重
        `Value-Weighted` = sum(w * Re), # 時価総額加重
        .groups = "drop"
    ) |>
    pivot_longer(-c(month_ID, BEME_rank10),
        names_to = "weighting", values_to = "Re"
    ) |>
    group_by(weighting, BEME_rank10) |>
    summarize(mean_Re = mean(Re), .groups = "drop") |>
    ggplot() +
    geom_col(aes(x = BEME_rank10, y = mean_Re)) +
    geom_hline(yintercept = 0) +
    facet_wrap(~weighting) +
    labs(x = "BE/ME Rank", y = "Mean Monthly Excess Return") +
    theme_classic()

教訓:等加重は、流動性が低く値動きの荒い小型株にも大型株と同額を投資するため、パフォーマンスを誇張しやすい(時価総額の分布が極端に歪んでいるため)。「ソートしたらリターンに差が出た」という主張を見たら、保有比率の決め方を必ず確認しよう。Fama-Frenchのファクター構築(6.3節)では時価総額加重が使われる。

7 6.2 CAPMの実証的な検証

7.1 なぜCAPMを検証するのか

全てのモデルは間違っているが、一部は有用である。 (All models are wrong, but some are useful.) — George E. Box

CAPMは「全投資家が同じ情報を持つ」「価格に影響を与えず自由に売買できる」など、明らかに非現実的な仮定の上に成り立っています。 しかし、ここで検証すべきは仮定の現実性ではなく、理論の予測がデータを説明できるかです。 CAPMが依拠している経済理論は些末な現実をあえて捨象し、単純化された世界を通じて本質を抽出するものだからです。

検証の論理:

  1. CAPMの第二命題は「リスクプレミアムはベータに比例する」という期待値に関する主張
  2. 実際に観察されるリターンは、これに誤差項が加わったものと考えられる
  3. すると検証は線形回帰の問題に帰着する

CAPMの検証を回帰式に落とし込むと、次のようになります。 まず第二命題に誤差項 \varepsilon_{i,t} を加えると、

\underbrace{R^e_{i,t}}_{\mathclap{\substack{\text{証券}i\text{の}\\ \text{実現超過}\\ \text{リターン}}}} = \beta_i \times \underbrace{R^e_{M,t}}_{\mathclap{\substack{\text{市場の}\\ \text{実現超過}\\ \text{リターン}}}} + \; \varepsilon_{i,t} \tag{6.1}

ここで誤差項には E[\varepsilon_{i,t}] = 0E[R^e_{M,t}\varepsilon_{i,t}] = 0(市場リターンと無相関)を仮定します。 実際の検証では、定数項 \alpha_P をあえて含めたモデルを推定します。 これで単純回帰の形になり、CAPMの成立を検定できるようになります。

R^e_{P,t} = \underbrace{\alpha_P}_{\mathclap{\substack{\text{CAPMが成立すれば}\\ \text{ゼロ}}}} + \; \beta_P \times R^e_{M,t} + \varepsilon_{P,t} \tag{6.2}

  • CAPMが正しければ、超過リターンはベータだけで説明できるので \alpha_P = 0 のはず
  • 推定された \hat{\alpha}_P が有意にゼロと異なれば、それはCAPMが成立していない証拠
  • この定数項を CAPMアルファ と呼ぶ

検証対象は個別銘柄ではなく、6.1.2節で作った十分位ポートフォリオを使用します(個別銘柄の誤差項の影響を平均化して小さくするため)。

まずした準備として、回帰の説明変数となる市場ポートフォリオの超過リターン R_Me を、被説明変数側のデータに結合します。

ME_sorted_portfolio <- factor_data |>
    select(-R_F) |> # 無リスク金利は不要なので除外
    full_join(ME_sorted_portfolio, by = "month_ID") |> # month_IDをキーに結合
    relocate(R_Me, .after = Re) # R_MeをReの右隣に移動

ME_sorted_portfolio |> head()
# A tibble: 6 × 5
  month_ID     R_M ME_rank10       Re    R_Me
     <int>   <dbl> <fct>        <dbl>   <dbl>
1       13 0.00993 1         -0.00936 0.00983
2       13 0.00993 2          0.00977 0.00983
3       13 0.00993 3         -0.00173 0.00983
4       13 0.00993 4          0.00184 0.00983
5       13 0.00993 5          0.00280 0.00983
6       13 0.00993 6          0.00798 0.00983

これで各行が「ある月のあるポートフォリオ」を表し、被説明変数 Re と説明変数 R_Me が横に並んだ、回帰にそのまま使える形になりました。

7.2 クロスセクション回帰 : 最小サイズのポートフォリオ

特定のポートフォリオについて、その超過リターンの時系列を市場超過リターンの時系列で回帰します。 まずは最小サイズ(ランク1)で試します。

small_portfolio <- ME_sorted_portfolio |>
    filter(ME_rank10 == 1) # 時価総額が最小のポートフォリオを抽出

lm(Re ~ R_Me, data = small_portfolio) |> # 時系列回帰
    modelsummary(
    gof_omit    = "Adj|Within|IC|RMSE", 
    gof_map = c("nobs", "r.squared"),
    stars = c('*' = .05, '**' = .01, '***' = .001),
    ) # 結果をデータフレームで表示
(1)
* p < 0.05, ** p < 0.01, *** p < 0.001
(Intercept) 0.005
(0.003)
R_Me 1.092***
(0.067)
Num.Obs. 60
R2 0.819

結果の読み方:

  • R_Me の係数 = マーケット・ベータ \hat{\beta}_P。正なら市場と正に連動
  • (Intercept) = CAPMアルファ \hat{\alpha}_Pstatistic(t値)と p.value で「\alpha_P = 0」という帰無仮説を検定できる
  • p値が小さければ、CAPMが成立していない可能性が高い

テキストでは %>% パイプとピリオド . を使って1本のパイプラインで書いていますが、 ここでは分析の手順を「データの絞り込み」と「モデルの推定」で分けるため、いったん中間オブジェクトsmall_portfolioに代入しています。 また、modelsummary() は回帰結果をきれいに表形式で表示するパッケージです。tidy() でも同じ情報を取得できます。

回帰の中身を直感的に掴むには散布図が一番なので、x軸に市場超過リターン、y軸にポートフォリオ超過リターンを取った散布図をggplot2で書きます。

ME_sorted_portfolio |>
    filter(ME_rank10 == 1) |>
    ggplot(aes(x = R_Me, y = Re)) + # aes()は各geomに共通で引き継がれる
    geom_point() +
    geom_smooth(method = "lm", color = "black") + # 回帰直線 + 95%信頼区間(灰色の帯)
    labs(
        x = "市場ポートフォリオの超過リターン",
        y = "小型ポートフォリオの超過リターン"
    ) +
    mystyle

  • 各点は1ヶ月分の観測値(60ヶ月分)
  • 直線の傾きがマーケット・ベータ、切片がCAPMアルファ
  • 灰色の帯は回帰直線の95%信頼区間(se = FALSE を付けなければ表示される)

最小サイズのポートフォリオを確認できたので、次は10ポートフォリオすべてについて同じ回帰を繰り返します。 テキストでは繰り返し処理の方法として for 文を使っていますが、ここではtidyverseの思想に沿って nest + map で書きます(書籍6.2.3節コラムの方法)。

CAPM_results <- ME_sorted_portfolio |>
    nest(data = -ME_rank10) |>
    mutate(
        model = map(data, ~ lm(Re ~ R_Me, data = .x)),
        results = map(model, tidy)
    ) |>
    select(ME_rank10, results) |>
    unnest(results)

CAPM_results
# A tibble: 20 × 6
   ME_rank10 term         estimate std.error statistic  p.value
   <fct>     <chr>           <dbl>     <dbl>     <dbl>    <dbl>
 1 1         (Intercept)  0.00490   0.00269      1.82  7.35e- 2
 2 1         R_Me         1.09      0.0675      16.2   3.52e-23
 3 2         (Intercept)  0.00500   0.00250      2.00  4.99e- 2
 4 2         R_Me         1.06      0.0626      16.9   4.93e-24
 5 3         (Intercept)  0.00326   0.00211      1.54  1.29e- 1
 6 3         R_Me         1.01      0.0530      19.0   1.53e-26
 7 4         (Intercept)  0.00337   0.00187      1.81  7.60e- 2
 8 4         R_Me         1.06      0.0468      22.7   1.56e-30
 9 5         (Intercept)  0.00138   0.00144      0.959 3.42e- 1
10 5         R_Me         1.09      0.0361      30.2   3.87e-37
11 6         (Intercept)  0.00238   0.00143      1.66  1.02e- 1
12 6         R_Me         1.06      0.0360      29.6   1.06e-36
13 7         (Intercept) -0.000202  0.00122     -0.166 8.69e- 1
14 7         R_Me         1.04      0.0306      34.1   4.80e-40
15 8         (Intercept)  0.000418  0.00106      0.395 6.95e- 1
16 8         R_Me         1.02      0.0266      38.2   7.80e-43
17 9         (Intercept)  0.00161   0.000797     2.02  4.76e- 2
18 9         R_Me         1.02      0.0200      51.2   5.47e-50
19 10        (Intercept) -0.000874  0.000673    -1.30  1.99e- 1
20 10        R_Me         1.03      0.0169      61.2   2.25e-54

このコードの流れは、

  1. nest(data = -ME_rank10): ME_rank10 ごとにデータをまとめて、各グループのミニ・データフレームを作る
  2. map(data, ~ lm(Re ~ R_Me, data = .x)): 各ミニ・データフレームに対して同じ回帰を適用する
  3. map(model, tidy): 回帰結果を整形してデータフレーム化する
  4. unnest(results): リスト化された結果を展開する

となります。for 文よりも関数型プログラミングの考え方に沿った書き方で、コードが短くなり、処理の意図が明確になります。

7.3 CAPMアルファの可視化

推定結果から定数項((Intercept))だけを取り出し、ポートフォリオごとに棒グラフで比較してみましょう。

CAPM_results |>
    filter(term == "(Intercept)") |> # 定数項に関する推定結果のみを抽出
    ggplot() +
    aes(x = ME_rank10, y = estimate) + # x軸:ランク、y軸:CAPMアルファ
    geom_col() + # 棒グラフ
    geom_hline(yintercept = 0) + # y=0の水平線を引く
    labs(x = "ME Rank", y = "CAPM alpha") + # ラベル
    mystyle

時価総額が小さいポートフォリオほどCAPMアルファが大きい。 つまり、6.1.2節で見た「小型株ほど超過リターンが高い」という傾向は、マーケット・ベータを調整した後でも消えないことが分かります。 月次アルファが1%なら年率換算で約12%にもなり、経済的にも無視できない大きさです。 CAPMは現実のデータ(ここではシミュレーションで作ったデータですが)を説明できないことが明らかになりました。

棒グラフだけでは統計的有意性が分からないので、p値に応じてアスタリスクを付けた一覧表を作ります。 cut() はデータを任意の境界で区切ってラベルを与える関数で、引数として

  • breaks:区切る境界のベクトル
  • labels:各区間に対応するラベルのベクトル

を指定して使います。

CAPM_results |>
    filter(term == "(Intercept)") |>
    rename(CAPM_alpha = estimate, p_value = p.value) |>
    mutate(significance = cut(
        p_value,
        breaks = c(0, 0.01, 0.05, 0.1, 1),
        labels = c("***", "**", "*", ""),
        include.lowest = TRUE
    )) |> # 下側境界0を含める
    select(ME_rank10, CAPM_alpha, p_value, significance)
# A tibble: 10 × 4
   ME_rank10 CAPM_alpha p_value significance
   <fct>          <dbl>   <dbl> <fct>       
 1 1           0.00490   0.0735 "*"         
 2 2           0.00500   0.0499 "**"        
 3 3           0.00326   0.129  ""          
 4 4           0.00337   0.0760 "*"         
 5 5           0.00138   0.342  ""          
 6 6           0.00238   0.102  ""          
 7 7          -0.000202  0.869  ""          
 8 8           0.000418  0.695  ""          
 9 9           0.00161   0.0476 "**"        
10 10         -0.000874  0.199  ""          
  • breaks で区間 [0, 0.01], (0.01, 0.05], (0.05, 0.1], (0.1, 1] を定義し、labels で各区間に ***, **, *, (なし) を対応
  • 小型のポートフォリオで統計的に有意な正のアルファが観察

シミュレーションだけでなく、現実のデータでも同じ現象が観察されることが知られています。

  • 規模効果(size effect):時価総額が小さい銘柄ほど、平均的に超過リターンが高い
  • バリュー効果(value effect):BE/MEが高いバリュー株ほど、平均的に超過リターンが高い

どちらもCAPMでは説明できない、正のCAPMアルファとして現れてきます。 こうした現象をアノマリー(anomaly)とよびます。

アノマリーを受けた実証ファイナンスの発展は、

  1. 「CAPMは洗練されているが、現実を説明するには単純すぎる」という認識が広がった
  2. CAPMが見落としている隠れたファクターが存在し、それを無視したせいで小型株・バリュー株に「見かけ上のアルファ」が観察されるのではないか、と考えられた
  3. この試行錯誤から頭角を現したのが Fama-Frenchの3ファクター・モデル(6.3節)

という流れになっており、現在はさらに隠れファクターとして、

  • モメンタム効果(momentum effect) : Carhart 4ファクター・モデル
  • 利益性効果(profitability effect) : Fama-French 5ファクター・モデル
  • 投資効果(investment effect) : Fama-French 5ファクター・モデル
  • 流動性効果(liquidity effect) : Pastor-Stambaugh 2ファクター・モデル

などがあります。 詳しくは、太田 (2026)「ビジネス・アナリティクス」の第11章を参照しましょう。

補足:各アルファを個別に検定する代わりに、「全ポートフォリオのアルファが同時にゼロ」を検定するGRSテスト(Gibbons, Ross, and Shanken 1989)という方法もあります。

7.4 証券市場線(SML)の理論

CAPMが成立する世界では、任意のポートフォリオPのリスクプレミアムは

E[R^e_P] = \beta_P \, E[R^e_M]

を満たすため、(\beta_P, E[R^e_P]) 平面上で全ポートフォリオが原点を通る一本の直線(証券市場線)の上に乗ります。 ここで、傾きは市場リスクプレミアム E[R^e_M] となります。 回帰の推定値との関係から見ると、回帰式を全期間で平均すると(残差の平均はゼロなので)

\bar{R}^e_P = \hat{\alpha}_P + \hat{\beta}_P \bar{R}^e_M \quad\Longleftrightarrow\quad \hat{\alpha}_P = \bar{R}^e_P - \hat{\beta}_P \bar{R}^e_M

となります。 つまり CAPMアルファは証券市場線からの縦方向の乖離幅 と解釈できます。 よって、CAPMの成立を視覚的に確認するには、各ポートフォリオの平均超過リターンとベータを結んだ点がSML上に乗るかどうかを見ればよいことになります。

  • 全ポートフォリオが線上に乗る → CAPM成立
  • 線から系統的に外れる → CAPM不成立の視覚的な証拠

ベータの推定値と平均超過リターンを結合し、SMLと重ねてグラフを描いてみましょう。

ME_cross_sectional_return <- CAPM_results |>
    filter(term == "R_Me") |> # ベータに関する推定結果のみを抽出
    select(ME_rank10, CAPM_beta = estimate) |> # 抽出と同時に列名を変更
    left_join(ME_cross_sectional_return, by = "ME_rank10")

mean_R_Me <- mean(factor_data$R_Me) # SMLの傾き = 市場の平均超過リターン

ggplot(ME_cross_sectional_return) +
    aes(x = CAPM_beta, y = mean_Re) + # x軸:ベータ、y軸:平均超過リターン
    geom_point() + # 各ポートフォリオの点
    geom_abline(intercept = 0, slope = mean_R_Me) + # 切片0, 傾きmean_R_MeのSML
    labs(x = "市場ベータ", y = "平均超過リターン") +
    mystyle

グラフから、各ポートフォリオの点の多く(特に小型株)は証券市場線から大きく上に乖離していることが分かります。 この縦方向の乖離幅こそがCAPMアルファであり、このデータでCAPMが成立していないことの実証的証拠といえます。 なお、点をうまく説明するように改めて回帰して傾きを求める方法は横断的回帰(cross-sectional regression)と呼ばれ、 市場で取引されていないファクターのリスクプレミアム推定に使われます。

8 6.3 Fama-Frenchの3ファクター・モデル

8.1 線形ファクター・モデルの一般形

CAPMの拡張・修正の多くは線形ファクター・モデルという枠組みに属しています。 つまり、任意の証券の超過リターンが、N個のファクター(確率変数)F^n_t の線形結合で書ける、というモデルです。

R^e_{i,t} = \beta^1_i F^1_t + \beta^2_i F^2_t + \cdots + \beta^N_i F^N_t + \varepsilon_{i,t}

ただし E[\varepsilon_i] = 0\mathrm{Cov}[\varepsilon_i, F^n] = 0

  • \beta^n_iファクター・ローディング:証券iのリターンとファクターF^nの共変動の強さ
  • ローディングは重回帰分析で推定できる。ただし通常の回帰と違い、理論上は定数項が入らない点がポイント
  • CAPMはファクターが F^1_t = R_{M,t} - R_{F,t} の1個だけ(N=1)という特殊ケース

ファクターの候補は理論上何でもよい(GDPやインフレ率などのマクロ変数でも可)。「あるファクターに関して線形ファクター・モデルが成立する」こと自体は、CAPMほど強い仮定なしに正当化できる(無裁定価格理論APTやICAPM)。

8.2 FF3モデルの全体像

Fama-Frenchの3ファクター・モデル(FF3モデル) は、CAPMアノマリー(規模効果・バリュー効果)をモデルに取り込むため、市場ファクターに2つのファクターを追加したモデル。代表論文は Fama and French (1993)。

R^e_{i,t} = \beta^M_i R^e_{M,t} + \beta^{SMB}_i SMB_t + \beta^{HML}_i HML_t + \varepsilon_{i,t} \tag{6.3}

ファクター 名前の由来 捉える現象
R^e_{M,t} 市場ファクター 市場全体との連動(CAPMと同じ)
SMB_t Small-Minus-Big 規模効果:小型株 − 大型株のリターン差
HML_t High-Minus-Low バリュー効果:高BE/ME株 − 低BE/ME株のリターン差
  • SMB_tHML_t はどちらもロング・ショート戦略のリターンとして定義される
  • FF3モデルはCAPMで説明できないリターンの規則性を説明できることから、実証ファイナンスで最も引用される研究成果の一つ

8.3 SMBとHMLの作り方:2×3ソート

銘柄ユニバースを時価総額で2分割 × BE/MEで3分割 = 6つのサブポートフォリオに分ける。

小型株 (Small) 大型株 (Big) 境界
バリュー株(High BE/ME) S/H B/H BE/MEの70%分位点より上
ニュートラル S/N B/N 30〜70%分位点
グロース株(Low BE/ME) S/L B/L 30%分位点より下

(時価総額は中央値で2分割。BE/MEだけ3分割するのは、開発当時の米国市場でBE/MEの方が説明力が強かったため)

各セルで時価総額加重ポートフォリオを作り、ファクターは次のように計算する。

SMB_t = \underbrace{\frac{S/H_t + S/N_t + S/L_t}{3}}_{\text{小型株の平均リターン}} - \underbrace{\frac{B/H_t + B/N_t + B/L_t}{3}}_{\text{大型株の平均リターン}}

HML_t = \underbrace{\frac{S/H_t + B/H_t}{2}}_{\text{バリュー株の平均リターン}} - \underbrace{\frac{S/L_t + B/L_t}{2}}_{\text{グロース株の平均リターン}}

SMB_t は「大型株3ポートフォリオをショートし、その資金で小型株3ポートフォリオをロングする」戦略の月次リターン。HML_t も同様に「グロースをショートしてバリューをロング」。

8.4 銘柄のランク付け (1):時価総額で2分割

6つのポートフォリオは lagged_MElagged_BEME両方が観測できる銘柄から組成する。そこで、lagged_BEME が欠損している銘柄は lagged_ME も欠損扱いにしてユニバースから外す。

annual_data <- annual_data |>
    mutate(lagged_ME = replace(lagged_ME, is.na(lagged_BEME), NA)) |> # 両方観測できる銘柄に限定
    group_by(year) |>
    mutate(ME_rank2 = as.factor(ntile(lagged_ME, 2))) |> # 中央値で2分割 (1=Small, 2=Big)
    ungroup()
  • ntile(lagged_ME, 2):中央値を境に、下半分に1、上半分に2を割り振る
  • ntile() に欠損値を含むデータを渡すと、欠損は欠損のまま残り、残りができる限り等数になるよう分割される

8.5 銘柄のランク付け (2):BE/MEで3分割

BE/MEは30%・70%分位点で分割したい。しかし ntile(lagged_BEME, 3) では33.3%・66.6%の等分割になってしまう。そこで percent_rank() + cut() を組み合わせる。

annual_data <- annual_data |>
    group_by(year) |>
    mutate(BEME_percent_rank = percent_rank(lagged_BEME)) |> # 年度ごとに[0,1]のパーセンタイル順位
    ungroup() |>
    mutate(BEME_rank3 = cut(BEME_percent_rank,
        breaks = c(0, 0.3, 0.7, 1), # 30%と70%を境界に
        labels = c(1, 2, 3), # 1=Low(グロース), 3=High(バリュー)
        include.lowest = TRUE
    ))
  • percent_rank():各データの順位を [0, 1] に基準化して返す(dplyr)
  • cut():任意の境界 breaks でデータを区切り、labels を付与する
  • include.lowest = TRUE で区間が [0, 0.3], (0.3, 0.7], (0.7, 1] となり、順位0(最小値)も漏れなく含まれる

ntile() は等分割専用、任意の分位点で切りたければ percent_rank() + cut() と覚えよう。

8.6 6ポートフォリオへの分類

2つのランク変数の組合せで6分類を作る。複数のファクター型変数を組み合わせるには interaction() が便利。

annual_data <- annual_data |>
    mutate(FF_portfolio_type = interaction(ME_rank2, BEME_rank3))

levels(annual_data$FF_portfolio_type)
[1] "1.1" "2.1" "1.2" "2.2" "1.3" "2.3"

作られた水準名は「ME_rank2 の値 . BEME_rank3 の値」の形式。たとえば 1.3 は「小型(1)× 高BE/ME(3)」= S/H を意味する。分かりやすい名前に付け替えるには forcats の fct_recode() を使う。

annual_data <- annual_data |>
    mutate(FF_portfolio_type = fct_recode(FF_portfolio_type,
        SL = "1.1", BL = "2.1", # Low BE/ME (グロース)
        SN = "1.2", BN = "2.2", # Neutral
        SH = "1.3", BH = "2.3"
    )) # High BE/ME (バリュー)

fct_recode(ファクター, 新しい名前 = "元の名前", ...) という書き方。カテゴリー変数の整備はforcatsパッケージの得意分野である。

8.7 6ポートフォリオの特徴を確認

分類がうまくいったか、各ポートフォリオの平均BE/ME・平均時価総額・平均構成銘柄数を集計して確かめる。

annual_data |>
    group_by(ME_rank2, BEME_rank3) |>
    summarize(
        FF_portfolio_type = FF_portfolio_type[1],
        mean_BEME = mean(lagged_BEME),
        mean_ME = mean(lagged_ME),
        mean_N_stocks = n() / length(unique(year)), # 年あたりの平均構成銘柄数
        .groups = "drop"
    ) |>
    drop_na()
# A tibble: 6 × 6
  ME_rank2 BEME_rank3 FF_portfolio_type mean_BEME mean_ME mean_N_stocks
  <fct>    <fct>      <fct>                 <dbl>   <dbl>         <dbl>
1 1        1          SL                    0.446    20.8          155.
2 1        2          SN                    0.739    21.0          200.
3 1        3          SH                    1.31     21.5          131.
4 2        1          BL                    0.450   405.           137.
5 2        2          BN                    0.739   343.           188.
6 2        3          BH                    1.28    326.           161.

チェックポイント:

  • S系(ME_rank2 = 1)とB系で mean_ME が桁違いになっているか
  • H系(BEME_rank3 = 3)ほど mean_BEME が高いか
  • 銘柄数はBE/ME方向で3:4:3(30%・40%・30%)に近い比率か

8.8 6ポートフォリオのリターン計算

各年・各ポートフォリオ内で時価総額加重の保有比率 w を計算し、月次の加重平均リターンを求める。

# (1) ポートフォリオ内の保有比率
annual_data <- annual_data |>
    group_by(year, FF_portfolio_type) |>
    mutate(w = lagged_ME / sum(lagged_ME, na.rm = TRUE)) |>
    ungroup()

# (2) 月次データと結合して加重平均リターンを計算
FF_portfolio <- annual_data |>
    select(year, firm_ID, FF_portfolio_type, ME_rank2, BEME_rank3, w) |>
    full_join(monthly_data, by = c("year", "firm_ID")) |>
    group_by(month_ID, FF_portfolio_type) |>
    summarize(
        ME_rank2 = ME_rank2[1],
        BEME_rank3 = BEME_rank3[1],
        R = sum(w * R, na.rm = TRUE), # 時価総額加重の月次リターン
        R_F = R_F[1],
        .groups = "drop"
    ) |>
    drop_na()

FF_portfolio
# A tibble: 360 × 6
   month_ID FF_portfolio_type ME_rank2 BEME_rank3       R    R_F
      <int> <fct>             <fct>    <fct>        <dbl>  <dbl>
 1       13 SL                1        1          0.00118 0.0001
 2       13 BL                2        1          0.0125  0.0001
 3       13 SN                1        2          0.00228 0.0001
 4       13 BN                2        2          0.00682 0.0001
 5       13 SH                1        3          0.00287 0.0001
 6       13 BH                2        3          0.0133  0.0001
 7       14 SL                1        1          0.0466  0.0001
 8       14 BL                2        1          0.0422  0.0001
 9       14 SN                1        2          0.0537  0.0001
10       14 BN                2        2          0.0419  0.0001
# ℹ 350 more rows

市場ポートフォリオ(6.1.1節)と同じ流れの繰り返し:保有比率を年次で決める → 月次に結合 → 加重平均。違いはグループが「市場全体」から「6つのサブポートフォリオ」になっただけ。

8.9 6ポートフォリオの平均超過リターン

サブグループ別の棒グラフは fillposition = "dodge" で横に並べ、geom_text() でポートフォリオ名を貼る。

FF_portfolio_mean_return <- FF_portfolio |>
    mutate(Re = R - R_F) |>
    group_by(FF_portfolio_type) |>
    summarize(
        ME_rank2   = ME_rank2[1],
        BEME_rank3 = BEME_rank3[1],
        mean_Re    = mean(Re)
    )

ggplot(FF_portfolio_mean_return) +
    geom_col(aes(x = BEME_rank3, y = mean_Re, fill = ME_rank2),
        position = "dodge"
    ) + # サブグループを横に並べる
    geom_text(
        aes(
            x = BEME_rank3, y = mean_Re, group = ME_rank2,
            label = FF_portfolio_type
        ),
        vjust = -0.5, # ラベルを棒の少し上に
        position = position_dodge(width = 0.9)
    ) + # 棒のずれに合わせてラベルもずらす
    scale_fill_grey() + # モノトーンの塗り分け
    labs(x = "BE/ME Rank", y = "Mean Monthly Excess Return", fill = "ME Rank") +
    scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
    theme_classic()

時価総額が小さいほど(S系 > B系)、そしてBE/MEが高いほど(H > N > L)、平均超過リターンが大きいという2方向の傾向が確認できる。これがSMB・HMLの「原材料」となる。

8.10 対極の2つを比較:S/H vs B/L

小型バリュー(S/H)と大型グロース(B/L)の累積リターンを比較する。

initial_point <- tibble(
    month_ID = c(12, 12), # 累積リターンの起点(元本1)
    cumulative_gross_R = c(1, 1),
    FF_portfolio_type = c("BL", "SH")
)

FF_cumulative_return <- FF_portfolio |>
    group_by(FF_portfolio_type) |>
    mutate(cumulative_gross_R = cumprod(1 + R)) |> # ポートフォリオごとに累積
    ungroup() |>
    filter(FF_portfolio_type %in% c("BL", "SH")) |>
    mutate(FF_portfolio_type = as.character(FF_portfolio_type)) |>
    select(month_ID, cumulative_gross_R, FF_portfolio_type)

bind_rows(initial_point, FF_cumulative_return) |> # 起点を先頭に追加
    ggplot() +
    geom_line(aes(
        x = month_ID, y = cumulative_gross_R,
        linetype = FF_portfolio_type
    )) +
    scale_linetype_manual(values = c("longdash", "solid")) +
    geom_hline(yintercept = 1, linetype = "dotted") +
    labs(x = "Month ID", y = "Cumulative Gross Return", linetype = "") +
    scale_x_continuous(expand = c(0, 0)) +
    theme_classic()

cumprod() の前に group_by() している点に注意。累積はポートフォリオごとに別々に計算しなければならない。

8.11 縦長から横長へ:pivot_wider()

SMB・HMLの計算には「各月について6ポートフォリオのリターンを足し引きする」必要がある。縦長(1行 = 月×ポートフォリオ)のままでは計算しにくいので、横長(1行 = 月、列 = ポートフォリオ)に変換する。

FF_portfolio_wide <- FF_portfolio |>
    pivot_wider(
        id_cols = month_ID, # 横長になったとき各行を定義する列
        names_from = FF_portfolio_type, # 新しい列の名前になる変数
        values_from = R
    ) # 新しい列に入る値

FF_portfolio_wide
# A tibble: 60 × 7
   month_ID       SL       BL       SN       BN        SH       BH
      <int>    <dbl>    <dbl>    <dbl>    <dbl>     <dbl>    <dbl>
 1       13  0.00118  0.0125   0.00228  0.00682  0.00287   0.0133 
 2       14  0.0466   0.0422   0.0537   0.0419   0.0571    0.0450 
 3       15  0.00621 -0.00715  0.00285 -0.00149  0.000386  0.00442
 4       16 -0.0173  -0.0261  -0.0180  -0.0150  -0.00591  -0.0122 
 5       17 -0.0194  -0.0337  -0.0252  -0.0226  -0.0209   -0.0468 
 6       18  0.0677   0.0735   0.0794   0.0565   0.0655    0.0556 
 7       19  0.0378   0.00511  0.0212  -0.00850  0.0115   -0.0122 
 8       20 -0.0247  -0.0273  -0.0301  -0.0182  -0.0323   -0.0276 
 9       21 -0.0591  -0.0463  -0.0534  -0.0506  -0.0578   -0.0347 
10       22  0.0102   0.00347  0.0260   0.00346  0.0158    0.0196 
# ℹ 50 more rows

pivot_wider() の3つの引数:

  • id_cols:行を識別するキー(ここでは月)
  • names_from:値が列名になる変数(SL, BL, SN, BN, SH, BHの6列ができる)
  • values_from:セルに入る値(リターン)

指定しなかった列は自動的に捨てられる。逆向きの変換(横長→縦長)は pivot_longer()

8.12 SMBとHMLの計算

横長になったので、ファクターの定義式をそのまま mutate() に書ける。

factor_data <- FF_portfolio_wide |>
    mutate(
        SMB = (SH + SN + SL) / 3 - (BH + BN + BL) / 3, # 小型平均 - 大型平均
        HML = (SH + BH) / 2 - (SL + BL) / 2 # バリュー平均 - グロース平均
    ) |>
    select(month_ID, SMB, HML) |>
    full_join(factor_data, by = "month_ID") |> # 市場ファクターと合流
    select(month_ID, R_F, R_M, R_Me, SMB, HML) # 列の並びを整理

factor_data
# A tibble: 60 × 6
   month_ID    R_F       R_M      R_Me      SMB      HML
      <int>  <dbl>     <dbl>     <dbl>    <dbl>    <dbl>
 1       13 0.0001  0.00993   0.00983  -0.00876  0.00125
 2       14 0.0001  0.0435    0.0434    0.00946  0.00666
 3       15 0.0001 -0.000897 -0.000997  0.00456  0.00287
 4       16 0.0001 -0.0169   -0.0170    0.00406  0.0126 
 5       17 0.0001 -0.0326   -0.0327    0.0125  -0.00731
 6       18 0.0001  0.0614    0.0613    0.00895 -0.0101 
 7       19 0.0001 -0.00442  -0.00452   0.0287  -0.0218 
 8       20 0.0001 -0.0239   -0.0240   -0.00470 -0.00398
 9       21 0.0001 -0.0451   -0.0452   -0.0129   0.00643
10       22 0.0001  0.00906   0.00896   0.00848  0.0109 
# ℹ 50 more rows

これで factor_data3ファクターの月次実現値(市場超過リターン R_Me、サイズ SMB、バリュー HML)が揃った。

factor_data |>
    summarize(across(c(R_Me, SMB, HML), mean))
# A tibble: 1 × 3
     R_Me     SMB     HML
    <dbl>   <dbl>   <dbl>
1 0.00417 0.00316 0.00478

SMB・HMLの平均が正 = 小型株・バリュー株が平均的に勝ってきた、という規模効果・バリュー効果の別表現になっている。

8.13 FF3モデルの推定

CAPMのときと同じ十分位ポートフォリオを、今度は3ファクターで重回帰する。

R^e_{P,t} = \alpha^{FF3}_P + \beta^M_P R^e_{M,t} + \beta^{SMB}_P SMB_t + \beta^{HML}_P HML_t + \varepsilon_{P,t} \tag{6.4}

FF3モデルが正しければ、FF3アルファ \alpha^{FF3}_P はゼロになるはず。nest + map のパターンを再利用する(変わるのは回帰式だけ!)。

FF3_results <- ME_sorted_portfolio |>
    select(-c(R_Me, R_M)) |> # 古い市場リターン列を除いてから
    left_join(factor_data, by = "month_ID") |> # 3ファクターの実現値を結合
    group_by(ME_rank10) |>
    nest() |>
    mutate(
        model  = map(data, \(df) lm(Re ~ R_Me + SMB + HML, data = df)), # 重回帰
        tidied = map(model, tidy)
    ) |>
    select(ME_rank10, tidied) |>
    unnest(tidied) |>
    ungroup()

FF3_results |> slice_head(n = 8)
# A tibble: 8 × 6
  ME_rank10 term         estimate std.error statistic  p.value
  <fct>     <chr>           <dbl>     <dbl>     <dbl>    <dbl>
1 1         (Intercept)  0.000433  0.000773     0.560 5.78e- 1
2 1         R_Me         1.00      0.0183      55.0   2.07e-50
3 1         SMB          1.44      0.0525      27.4   3.91e-34
4 1         HML          0.0607    0.0463       1.31  1.95e- 1
5 2         (Intercept)  0.00142   0.000825     1.72  9.03e- 2
6 2         R_Me         0.976     0.0195      50.0   3.55e-48
7 2         SMB          1.30      0.0560      23.3   1.83e-30
8 2         HML         -0.0433    0.0494      -0.877 3.84e- 1

8.14 FF3アルファの可視化

CAPMアルファと同じ要領で、定数項を棒グラフにする。

FF3_results |>
    filter(term == "(Intercept)") |>
    ggplot() +
    geom_col(aes(x = ME_rank10, y = estimate)) +
    geom_hline(yintercept = 0) +
    labs(x = "ME Rank", y = "FF3 alpha") +
    theme_classic()

CAPMアルファのグラフと見比べると対照的で、どのポートフォリオもアルファがほぼゼロに潰れている。

つまり、CAPMが説明できなかった「小型株ほど超過リターンが高い」という規則性を、FF3モデルは(SMBへのローディングの違いとして)うまく説明できている。

8.15 FF3アルファの統計的有意性

FF3_results |>
    filter(term == "(Intercept)") |>
    rename(FF3_alpha = estimate, p_value = p.value) |>
    mutate(significance = cut(p_value,
        breaks = c(0, 0.01, 0.05, 0.1, 1),
        labels = c("***", "**", "*", ""),
        include.lowest = TRUE
    )) |>
    select(ME_rank10, FF3_alpha, p_value, significance)
# A tibble: 10 × 4
   ME_rank10  FF3_alpha p_value significance
   <fct>          <dbl>   <dbl> <fct>       
 1 1          0.000433  0.578   ""          
 2 2          0.00142   0.0903  "*"         
 3 3          0.000247  0.726   ""          
 4 4          0.000849  0.227   ""          
 5 5         -0.00108   0.0527  "*"         
 6 6          0.0000617 0.940   ""          
 7 7         -0.00218   0.00431 "***"       
 8 8         -0.000942  0.288   ""          
 9 9          0.000739  0.352   ""          
10 10        -0.00116   0.0967  "*"         

ほとんどのポートフォリオでFF3アルファは統計的に有意でなく、有意なものがあっても推定値自体は小さい。

解釈の論理を整理しよう:

  • 線形ファクター・モデルは定義上、任意の銘柄・ポートフォリオのリスクプレミアムを説明するはず
  • ファクター調整済みアルファが規則性を持って観察される → そのモデルは現実には成立していない
  • 規模別ソートという単純な手順でアルファが出るCAPMは、実証的な説明力が低い
  • FF3モデルは必要最小限のファクター数で様々なポートフォリオのリターンを説明できるため、広く支持されてきた

8.16 CAPM vs FF3:アルファの直接比較

2つのモデルのアルファを1枚のグラフで並べると、FF3モデルの説明力が一目で分かる。

bind_rows(
    CAPM_results |> filter(term == "(Intercept)") |> mutate(model = "CAPM"),
    FF3_results |> filter(term == "(Intercept)") |> mutate(model = "FF3")
) |>
    ggplot() +
    geom_col(aes(x = ME_rank10, y = estimate, fill = model),
        position = "dodge"
    ) +
    geom_hline(yintercept = 0) +
    scale_fill_grey() +
    labs(x = "ME Rank", y = "Alpha", fill = "Model") +
    theme_classic()

  • CAPMアルファ(薄い棒):小型株側で大きな正の値
  • FF3アルファ(濃い棒):どのランクでもほぼゼロ

作成したファクター・データは次章(資本コストの推定・平均分散ポートフォリオ)でも使うので、書籍ではここでCSVに保存している。

write_csv(factor_data, "ch06_output.csv") # 本ノートでは実行しない

9 6.4 パフォーマンス評価尺度としてのアルファ

9.1 アルファのもう一つの顔

ここまでアルファを「モデルが成立していない証拠」と解釈してきたが、実務ではファンド運用者のスキル評価基準として使われる(CAPMアルファはこの文脈で「ジェンセンのアルファ」と呼ばれる)。

例:ファンドAの3ヶ月の実績。

年月 R^e_A R^e_M
2020/10 −0.03 −0.03
2020/11 0.09 0.06
2020/12 0.00 −0.03
平均 0.02 0.00

市場を上回っており、一見この運用者には高報酬を与えるべきに思える。しかし、このファンドのリターンが実は

R^e_A = \beta^M_A R^e_M + \beta^{SMB}_A SMB + \beta^{HML}_A HML + \varepsilon_A, \qquad \beta^M_A = 0,\; \beta^{SMB}_A = 0.5,\; \beta^{HML}_A = 1

というFF3モデル(アルファはゼロ)から生成されていたとしたらどうか。

9.2 複製ポートフォリオの議論

ファクターの寄与分を \hat{R}_A = \beta^M_A R^e_M + \beta^{SMB}_A SMB + \beta^{HML}_A HML とすると、実現リターンは R^e_A = \hat{R}_A + \varepsilon_A と分解できる。市場超過分の正体が「たまたま正だった残差 \varepsilon_A」なら、それはスキルではなく運である。

核心となる論点:FF3の各ファクターは市場で取引可能なので、投資家は (\beta^M_A, \beta^{SMB}_A, \beta^{HML}_A) の割合で各ファクターを保有すれば、ファクター寄与分 \hat{R}_A自分で複製できる

しかも複製ポートフォリオは誤差項を含まないため、同じ期待リターンをより小さなリスクで実現する。

\mathrm{Var}[\hat{R}_A + \varepsilon_A] = \mathrm{Var}[\hat{R}_A] + \mathrm{Var}[\varepsilon_A] \geq \mathrm{Var}[\hat{R}_A]

(誤差項は各ファクターと無相関なので共分散項は消える)

結論:アルファこそがファンド運用者に固有の、複製不可能な付加価値であり、ファクターの寄与分を除いたアルファのみを報酬の対象とすべき、という主張につながる。

注意点:現実にはローディングは観測不可能で推定が必要な上、運用手法の変更でモデル自体が変化する(スタイル・ドリフト)ため、この議論をそのまま適用はできない。

9.3 本章のまとめ

ファイナンスの概念

  • 市場ポートフォリオ:時価総額加重・年次リバランスで構築。CAPM検証の土台
  • ポートフォリオ・ソート:特性でグループ化して平均リターンを比較する、実証ファイナンスの基本手法
  • CAPMアルファ:時系列回帰の定数項 = 証券市場線からの乖離。有意な正のアルファはCAPM不成立の証拠
  • 規模効果・バリュー効果:CAPMで説明できない代表的アノマリー
  • FF3モデル:SMB(小型−大型)とHML(バリュー−グロース)を追加し、アノマリーを説明
  • アルファ:モデルの検証装置であると同時に、運用スキルの評価尺度

Rの道具箱

やりたいこと 道具
グループごとのラグ・シェア計算 group_by() + lag() / mutate()
条件付きの値の置き換え replace()
等分割 / 任意分位点の分割 ntile() / percent_rank() + cut()
累積リターン cumprod()
グループごとの回帰 nest() + map() + tidy() + unnest()
縦長⇄横長の変換 pivot_wider() / pivot_longer()

次章では、この factor_data を使って資本コストの推定と平均分散ポートフォリオの構築に進む。

Back to top