library(foreign)
library(AER)
library(npcausal)
library(stargazer)
library(dagitty)
library(ggdag)
ivgraph<-dagitty("dag{Y<-X; X<-W; X<->Y}") #create graph
#Set position of nodes
coords<-list(x=c(X = 0, Y = 2, W=-1),y=c(X = 0, Y = 0, W=0))
coords_df<-coords2df(coords)
coordinates(ivgraph)<-coords2list(coords_df)
ggdag(ivgraph)+theme_dag_blank()+labs(title="Instrumental Variables",subtitle="Causal IV") #Plot causal graph
ivzgraph<-dagitty("dag{Y<-X; X<-W; X<->Y; Y<-Z; X<-Z; W<-Z}") #create graph
#Set position of nodes
coords<-list(x=c(X = 0, Z = -1, Y = 2, W=-1),y=c(X = 0, Z = 0.5, Y = 0, W=0))
coords_df<-coords2df(coords)
coordinates(ivzgraph)<-coords2list(coords_df)
ggdag(ivzgraph)+theme_dag_blank()+labs(title="Instrumental Variables",subtitle="Causal IV with Covariates") #Plot causal graph
AER
ivmodel
npcausal
np
hdm
, DoubleML partially linear IV or semiparametric LATE in DoubleML
#Load the data set from your directory
#In my case this is saved at
debate<-read.dta("Data/M_Washington_A_Chapter_2010_Dataset.dta")
#Assemble indicator for watched or didn't
debate$actwatch<-(debate$watchdps1=="yes"|debate$watchdps2=="yes")
debate$actwatch[is.na(debate$actwatch)]<-FALSE
debate$actwatch<-as.numeric(debate$actwatch)
#Alternately, use
debate$actwatch<-as.numeric(debate$watchdps)-1
ols<-lm(formula=bloomsc~actwatch,data=debate)
ols.results<-coeftest(ols,vcov=vcovHC(ols,type="HC3"))
reducedform<-lm(bloomsc~watch,data=debate)
reducedform.results<-coeftest(reducedform,vcov=vcovHC(reducedform,type="HC3"))
firststage<-lm(actwatch~watch,data=debate)
firststage.results<-coeftest(firststage,vcov=vcovHC(firststage,type="HC3"))
ivwatch<-ivreg(formula=bloomsc~actwatch|watch,data=debate)
ivwatch.results<-coeftest(ivwatch,vcov=vcovHC(ivwatch,type="HC3"))
stargazer(ivwatch.results,ols.results,firststage.results,reducedform.results,header=FALSE,
type="html",
omit.stat=c("adj.rsq"),
font.size="tiny",
title="Wald Estimate of Debate Watching on Candidate Score")
Dependent variable: | ||||
(1) | (2) | (3) | (4) | |
actwatch | 5.775 | -3.134 | ||
(8.192) | (2.035) | |||
watch | 0.205*** | 1.234 | ||
(0.027) | (1.733) | |||
Constant | 67.665*** | 70.111*** | 0.162*** | 68.631*** |
(2.409) | (0.985) | (0.017) | (1.229) | |
Note: | p<0.1; p<0.05; p<0.01 |
npcausal
for this
mydata<-data.frame(y=debate$bloomsc,a=debate$actwatch,z=debate$watch,x1=debate$female,x2=debate$black,x3=debate$white,x4=debate$age)
mydata<-na.omit(mydata)
x=as.matrix(mydata[,4:7])
set.seed(101)
boundsresults<-ivbds(y=mydata$y/100,a=mydata$a,z=mydata$z,x=x,nsplits=5,sl.lib=c("SL.glm","SL.ranger"))
##
|
| | 0%
|
|==== | 5%
|
|======= | 10%
|
|========== | 15%
|
|============== | 20%
|
|================== | 25%
|
|===================== | 30%
|
|======================== | 35%
|
|============================ | 40%
|
|================================ | 45%
|
|=================================== | 50%
|
|====================================== | 55%
|
|========================================== | 60%
|
|============================================== | 65%
|
|================================================= | 70%
|
|==================================================== | 75%
|
|======================================================== | 80%
|
|============================================================ | 85%
|
|=============================================================== | 90%
|
|================================================================== | 95%
|
|======================================================================| 100%
## parameter lb ub ci.ll ci.ul
## 1 ATE -0.48626192 0.29688835 -0.5230338 0.3310284
## 2 beta(h_q) -0.52000608 0.27717903 -0.6920250 0.3925359
## 3 LATE 0.02781938 0.02781938 -0.1394741 0.1951129
lateresults<-ivlate(y=mydata$y,a=mydata$a,z=mydata$z,x=x,nsplits=5,sl.lib=c("SL.glm","SL.ranger"))
##
|
| | 0%
|
|==== | 5%
|
|======= | 10%
|
|========== | 15%
|
|============== | 20%
|
|================== | 25%
|
|===================== | 30%
|
|======================== | 35%
|
|============================ | 40%
|
|================================ | 45%
|
|=================================== | 50%
|
|====================================== | 55%
|
|========================================== | 60%
|
|============================================== | 65%
|
|================================================= | 70%
|
|==================================================== | 75%
|
|======================================================== | 80%
|
|============================================================ | 85%
|
|=============================================================== | 90%
|
|================================================================== | 95%
|
|======================================================================| 100%
## parameter est se ci.ll ci.ul pval
## 1 LATE 2.9067270 8.60270865 -1.395458e+01 19.7680359 0.735
## 2 Strength 0.2132277 0.03017744 1.540799e-01 0.2723755 NA
## 3 Sharpness 0.0010000 0.07662264 5.159907e-69 1.0000000 NA
tslswatch<-ivreg(formula=bloomsc~actwatch+female+black+white+age|watch+female+black+white+age,data=debate)
(tslswatch.results<-coeftest(tslswatch,vcov=vcovHC(tslswatch,type="HC3")))
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 59.013126 5.025551 11.7426 < 2.2e-16 ***
## actwatch 3.534963 8.631364 0.4095 0.682240
## female -0.910754 1.841352 -0.4946 0.621002
## black -6.408480 4.122680 -1.5544 0.120450
## white 1.990523 3.679699 0.5409 0.588686
## age 0.153922 0.055601 2.7684 0.005756 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1