UPDATE: 2024-03-16 00:49:21.393683

はじめに

ここでは、Meta-LearnersのS-Learner、T-Learner、X-LearnerをRで実装してみる。PythonではEconMLパッケージが利用できるが、多分Rには今のところないはず。もしかしたらあるかも。

Meta-Learnersは、介入の効果が複雑であったり、効果が変数\(x\)ごとに異なる場合など、非線形な因果効果を推定する際に使用される。

CATE(Conditional Average Treatment Effects)

Meta-Learnersでは、CATEを推定する。CATEはある特徴量\(x\)で条件づけた時の介入に関する因果効果の期待値のことである。\(Y^{(1)},Y^{(0)}\)は潜在的結果(potential outcomes)である。

\[ \begin{aligned} \tau(X) = E \left[ Y^{(1)} - Y^{(0)} \, | \, X \right] \end{aligned} \]

CATEを推定することのメリットとしては、こちらのブログで書かれている通りである。個人的にはUplift Modelingみたいことをしたいのだけれど、データを簡単に取れないことがあった。

CATEを推定することができれば, 嬉しいことがたくさんあります. 例えば, 因果効果がプラスであるような特徴量を持つ人だけに広告を打つことで商品の購入確率を最大化したり, 投薬計画を最適化することで生存率を改善できるかもしれません. 似たような目的を持つ分野にUplift Modelingと呼ばれるものがあります（参考1, 参考2）が, Uplift ModelingはA/Bテスト (RCT)によって収集された学習データがあることを前提とします. しかし多くの場合, A/Bテストを走らせて学習データを集めるようなことはコストの面から望ましくなく, 容易に実適用可能な技術とは言えないでしょう.

以降、S-Learner、T-Learner、X-Learnerについて内容をまとめているが、変数の説明は下記の通りである。

  • X: 共変量(説明変数)
  • t: 介入の有無(0/1)
  • y: 目的変数
  • MODEL: 機械学習モデル

ここで使用するデータを読み込んでおく。また、モデルとしてランダムフォレストを利用するが、ハイパーパラメタのチューニングやバリデーションは行わない。

使用するデータはこちらよりお借りした。

options(scipen = 100000)
library(tidyverse)
library(randomForest)

df <- read_csv('~/Desktop/invest_email.csv') %>% 
  select(y = converted, t = em1, x1 = age, x2 = income, x3 = insurance, x4 = invested)

head(df)
## # A tibble: 6 × 6
##       y     t    x1     x2     x3     x4
##   <dbl> <dbl> <dbl>  <dbl>  <dbl>  <dbl>
## 1     1     0  44.1  4215. 14036.  7989.
## 2     0     1  39.8  1151. 66622.  1001.
## 3     0     0  49    8047. 14120. 29480.
## 4     0     0  39.7 10558. 14798. 36373.
## 5     0     1  35.3   802.   781.  1643.
## 6     1     0  40    1672. 80489.  2785.

投資を促すメールデータで、結果変数はconverted(投資した vs 投資してない)。説明変数には年齢age、所得income、保険額insurance、投資額investedがあり、介入はメール送信em1である。目的は、より良い反応をしている個人にのみメールを送りたい。つまり、em1の条件付き平均因果効果を推定したい。

\[ E[Converted(1)_i - Converted(0)_i|X_i=x] = \tau(x)_i \]

S-Learner(Single-Learner)

S-Learnerは下記の手順でCATEを推定する。

  1. 学習: 個人ごとのデータが記録されたX,t->yの機械学習モデルMODELを作成
  2. 予測: X, t=0を使って、MODELから予測値y0を得る(t=0にデータを固定して予測)
  3. 予測: X, t=1を使って、MODELから予測値y1を得る(t=1にデータを固定して予測)
  4. 評価: 予測値E[y1-y0]がCATEとなる

図はこちらよりお借りした。

手順および画像を参照しながらモデルを構築する。

model_s <- randomForest(y ~ x1 + x2 + x3 + x4 + t, data = df)
y1_s <- predict(model_s, df %>% mutate(t = 1), type = 'response') 
y0_s <- predict(model_s, df %>% mutate(t = 0), type = 'response')

bind_cols(df, y1_s = y1_s, y0_s = y0_s, ice = y1_s - y0_s)
## # A tibble: 5,000 × 9
##        y     t    x1     x2     x3     x4  y1_s  y0_s      ice
##    <dbl> <dbl> <dbl>  <dbl>  <dbl>  <dbl> <dbl> <dbl>    <dbl>
##  1     1     0  44.1  4215. 14036.  7989. 0.787 0.689  0.0978 
##  2     0     1  39.8  1151. 66622.  1001. 0.226 0.306 -0.0802 
##  3     0     0  49    8047. 14120. 29480. 0.553 0.548  0.00523
##  4     0     0  39.7 10558. 14798. 36373. 0.208 0.225 -0.0167 
##  5     0     1  35.3   802.   781.  1643. 0.243 0.282 -0.0397 
##  6     1     0  40    1672. 80489.  2785. 0.384 0.376  0.00822
##  7     0     1  36    1312.  5852.  1913. 0.278 0.252  0.0260 
##  8     1     0  49.7  6059.  7438. 12591. 0.818 0.729  0.0894 
##  9     0     0  38.4  2774. 44813.  1275. 0.316 0.267  0.0489 
## 10     0     1  41.6  5267.  3692.  6028. 0.654 0.628  0.0261 
## # ℹ 4,990 more rows

推定されたCATEは下記の通り。

# 可視化
# bind_cols(df, y1_s = y1_s, y0_s = y0_s) %>% 
#   ggplot(., aes(x4, y1_s - y0_s)) + 
#   geom_point() + 
#   theme_bw() + 
#   labs(y = 'CATE', title = 'S-Learner')

mean(y1_s - y0_s)
## [1] 0.06034141

T-Learner(Two-Learner)

T-Learnerは下記の手順でCATEを推定する。

  1. 学習: 個人ごとのt=0のデータに対し、X->yの機械学習モデルMODEL0を作成(学習時にtは使わない)
  2. 学習: 個人ごとのt=1のデータに対し、X->yの機械学習モデルMODEL1を作成(学習時にtは使わない)
  3. 予測: Xを使って、MODEL0から予測値y0を得る(tは予測には使わない)
  4. 予測: Xを使って、MODEL1から予測値y1を得る(tは予測には使わない)
  5. 評価: 予測値E[y1-y0]がCATEとなる

図はこちらよりお借りした。

手順および画像を参照しながらモデルを構築する。

model0_t <- randomForest(y ~ x1 + x2 + x3 + x4, data = df %>% filter(t == 0))
model1_t <- randomForest(y ~ x1 + x2 + x3 + x4, data = df %>% filter(t == 1))

y0_t <- predict(model0_t, df, type = 'response') 
y1_t <- predict(model1_t, df, type = 'response')

推定されたCATEは下記の通り。

# 可視化
# bind_cols(df, y1_t = y1_t, y0_t = y0_t) %>% 
#   ggplot(., aes(x, y1_t - y0_t)) + 
#   geom_point() + 
#   theme_bw() + 
#   labs(y = 'CATE', title = 'T-Learner')
mean(y1_t - y0_t)
## [1] 0.05789336

X-Learner

X-Learnerは下記の手順でCATEを推定する。傾向スコアの計算が必要だったり、構築されたモデルの推定値を利用するなど 、少し複雑な手順を踏む。

  1. 学習: 個人ごとのt=0のデータに対し、X->yの機械学習モデルMODEL0を作成(学習時にtは使わない)
  2. 学習: 個人ごとのt=1のデータに対し、X->yの機械学習モデルMODEL1を作成(学習時にtは使わない)
  3. 学習: 個人ごとのt=0のデータに対し、Xを使って、MODEL1から予測値y1を得る(MODEL0ではない)
  4. 学習: 個人ごとのt=0のデータに対し、y1-yをd0として計算
  • d0は介入を受けなかった個人の「介入を受けていないy」と「もし介入を受けた時のy1」の差分。
  • d0は介入を受けない個人の介入効果(ATU)。
  1. 学習: 個人ごとのt=1のデータに対し、Xを使って、MODEL0から予測値y0を得る(MODEL1ではない)
  2. 学習: 個人ごとのt=1のデータに対し、y-y0をd1として計算
  • d1は介入を受けた個人の「介入を受けたy」と「もし介入を受けなかった時のy0」の差分。
  • d1は介入を受けた個人の介入効果(ATT)。
  1. 学習: 個人ごとのt=0のデータに対し、X->d0の機械学習モデルMODEL00を作成(学習時にtは使わない)
  2. 学習: 個人ごとのt=1のデータに対し、X->d1の機械学習モデルMODEL11を作成(学習時にtは使わない)
  3. 学習: 個人ごとのデータに対し、X->tの機械学習モデルMODEL_psを作成(傾向スコアpsを計算)
  4. 予測: 個人ごとのデータに対し、Xを使って、MODEL00から予測値y0m0を得る
  5. 予測: 個人ごとのデータに対し、Xを使って、MODEL11から予測値y1m1を得る
  6. 予測: 個人ごとのデータに対し、Xを使って、MODEL-psから予測値pを得る
  7. 評価: 予測値(ps)*(y0m0)+(1-ps)*(y1m1)がCATEとなる

図はこちらよりお借りした。

手順および画像を参照しながらモデルを構築する。

df0 <- df %>% filter(t == 0) # 介入を受けてない集団
df1 <- df %>% filter(t == 1) # 介入を受けた集団

# 介入を受けてないモデル
model0_x <- randomForest(y ~ x1 + x2 + x3 + x4, data = df0)
# 介入を受けたモデル
model1_x <- randomForest(y ~ x1 + x2 + x3 + x4, data = df1)

# 推定された介入効果を各個人ごとに計算
d0 <- predict(model1_x, df0, type = 'response') - df0$y
d1 <- df1$y - predict(model0_x, df1, type = 'response')

# ATTを推定するモデル
model00_x <- randomForest(d0 ~ x1 + x2 + x3 + x4, df0)
# ATUを推定するモデル
model11_x <- randomForest(d1 ~ x1 + x2 + x3 + x4, df1)
# 傾向スコアを推定するモデル
model_ps <- randomForest(t ~ x1 + x2 + x3 + x4, df)

y0m0 <- predict(model00_x, df, type = 'response')
y1m1 <- predict(model11_x, df, type = 'response')
ps <- predict(model_ps, df, type = 'response')

ice <- ps * y0m0 + (1 - ps) * y1m1

推定されたCATEは下記の通り。

# 可視化
# bind_cols(df, cate = cate) %>% 
#   ggplot(., aes(x, cate)) + 
#   geom_point() + 
#   theme_bw() + 
#   labs(y = 'CATE', title = 'X-Learner')
mean(ice)
## [1] 0.06027891

おまけ

X-Learnerを使って、よく見る図を再現しておく。

df <- read_csv('~/Desktop/metalearner.csv')
df0 <- df %>% filter(t == 0)
df1 <- df %>% filter(t == 1)

model0_x <- randomForest(y ~ x, data = df0)
model1_x <- randomForest(y ~ x, data = df1)

d0 <- predict(model1_x, df0, type = 'response') - df0$y
d1 <- df1$y - predict(model0_x, df1, type = 'response')

model00_x <- randomForest(d0 ~ x, df0)
model11_x <- randomForest(d1 ~ x, df1)
model_ps <- randomForest(t ~ x, df)

y0m0 <- predict(model00_x, df, type = 'response')
y1m1 <- predict(model11_x, df, type = 'response')
ps <- predict(model_ps, df, type = 'response')

cate <- ps * y0m0 + (1 - ps) * y1m1
bind_cols(df, cate = cate) %>%
  ggplot(., aes(x, cate)) +
  geom_point() +
  theme_bw() +
  labs(y = 'CATE', title = 'X-Learner')