操作変数法

パッケージ

install.packages("fixest")
install.packages("AER")

library(fixest)
library(modelsummary)
library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

## ✔ ggplot2 3.3.6     ✔ purrr   0.3.4
## ✔ tibble  3.1.7     ✔ dplyr   1.0.9
## ✔ tidyr   1.2.0     ✔ stringr 1.4.0
## ✔ readr   2.1.2     ✔ forcats 0.5.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

データ

mydata <- tibble::tibble(wooldridge::card)

推定

mydata <- tibble::tibble(wooldridge::card)

i <- 662:669
model_ols <- feols(lwage ~ educ + poly(exper, 2) + black + 
                     smsa + south + smsa66 + + reg.[i], 
                   data = mydata)
model_iv <- feols(lwage ~ poly(exper, 2) + black + 
                    smsa + south + smsa66 + + reg.[i]
                  | educ ~ nearc4, 
                  data = mydata)

etable(model_ols, 
       model_iv)

##                           model_ols            model_iv
## Dependent Var.:               lwage               lwage
##                                                        
## (Intercept)       5.153*** (0.0573)   4.402*** (0.7281)
## educ             0.0747*** (0.0035)    0.1315* (0.0550)
## poly(exper)1      9.005*** (0.4942)     14.12** (4.960)
## poly(exper)2     -2.696*** (0.3733)  -2.753*** (0.3932)
## black           -0.1990*** (0.0182)  -0.1468** (0.0539)
## smsa             0.1364*** (0.0201)  0.1118*** (0.0317)
## south           -0.1480*** (0.0260) -0.1447*** (0.0273)
## smsa66              0.0262 (0.0194)     0.0185 (0.0216)
## reg662            0.0964** (0.0359)   0.1008** (0.0377)
## reg663           0.1445*** (0.0351)  0.1483*** (0.0368)
## reg664              0.0551 (0.0417)     0.0499 (0.0437)
## reg665            0.1280** (0.0418)   0.1463** (0.0471)
## reg666            0.1405** (0.0452)   0.1629** (0.0519)
## reg667            0.1180** (0.0448)   0.1346** (0.0494)
## reg668             -0.0564 (0.0513)    -0.0831 (0.0593)
## reg669            0.1186** (0.0388)   0.1078** (0.0418)
## _______________ ___________________ ___________________
## S.E. type                       IID                 IID
## Observations                  3,010               3,010
## R2                          0.29984             0.23817
## Adj. R2                     0.29633             0.23435
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

models <- list(
  "OLS" = model_ols,
  "2SLS" = model_iv
)

modelsummary(models, 
             stars  = TRUE,
             coef_rename = c("(Intercept)" = "切片",
                             "educ" = "教育年数",
                             "fit_educ" = "教育年数",
                             "poly(exper, 2)1" = "経験年数",
                             "poly(exper, 2)2" = "経験年数2乗",
                             "black"="黒人ダミー"),
             coef_omit = c("Intercept|reg*|south|smsa*"),
             gof_map = c("nobs", "r.squared"),
             fmt = "%.2f")

	OLS	2SLS
教育年数	0.07***	0.13*
	(0.00)	(0.05)
経験年数	9.01***	14.12**
	(0.49)	(4.96)
経験年数2乗	−2.70***	−2.75***
	(0.37)	(0.39)
黒人ダミー	−0.20***	−0.15**
	(0.02)	(0.05)
Num.Obs.	3010	3010
R2	0.300	0.238
+ p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001