第6章のRコード

第6章 相関関係と因果関係

サンプルデータ

video_game.csv：ビデオゲームのプレイ時間と学業成績の架空データ．

police_crime.csv：2014年における都道府県別の警察官の数と犯罪認知件数に関するデータ．

パッケージの読み込み

library(dplyr)
library(ggplot2)

6.1 相関 \(\neq\) 因果

videodata <- readr::read_csv("video_game.csv")

videodata %>% 
  ggplot(aes(x = hours, y = grade)) +
  geom_point()

videodata %>% 
  summarise(cor = cor(grade, hours))  
# A tibble: 1 × 1
     cor
   <dbl>
1 -0.821

6.1.3 同時性

crimedata <- readr::read_csv("police_crime.csv")

crimedata %>% 
  ggplot(aes(x = police, y = crime)) +
  geom_point()

crimedata %>% 
  summarise(cor = cor(police, crime))
# A tibble: 1 × 1
    cor
  <dbl>
1 0.129

6.2 ルービンの因果モデル

6.2.2 平均トリートメント効果

set.seed(2022)

n  <- 400
D  <- rbinom(n, 1, 0.6)  # 確率 0.6 で 1，確率 0.4 で 0 をとるトリートメント変数
TE <- 2                  # トリートメント効果 = 2 で個人間の差は無いと想定
Y  <- TE * D + rnorm(n)  # 結果変数

EY1 <- sum(D * Y) / sum(D)
EY0 <- sum((1 - D) * Y) / sum(1 - D)
EY1 - EY0
[1] 2.053911
Z <- runif(n)        # D と Y に共通して影響を与える変数
D <- rbinom(n, 1, Z) # Z が大きいほど 1 をとりやすいトリートメント変数
Y <- TE * D + (2 * Z - 1) + rnorm(n)

EY1 <- sum(D * Y) / sum(D)
EY0 <- sum((1 - D) * Y) / sum(1 - D)
EY1 - EY0
[1] 2.481898