搜索
人大经济论坛 附件下载

附件下载

所在主题:
文件名:  原始代码和数据.rar
资料下载链接地址: https://bbs.pinggu.org/a-2244817.html
附件大小:
117.07 KB   举报本内容
查了很多资料,都没有解决,所以请教各位大神,在此先谢过啦^_^

以下程序当执行到最后部分时,提示如下错误:
Error in if (loss.old <= loss.new) { : missing value where TRUE/FALSE needed

以下是程序的部分代码,代码中报错部分,在程序中也“标红”了

原始代码 Rcode20170503.R和数据 data20170503.csv如附件所示


#code to replicate analysis of Lalonde data
rm(list=ls())
library(foreign)
library(Matching)
library(survey)
library(lattice)
# package that implements entropy balancing
library(ebal)


dat <- read.table("data20170503.csv",header=T)
# unemployed
dat$u74 <- as.numeric(dat$re74==0)
dat$u75 <- as.numeric(dat$re75==0)


# covars
covars <- c("age","educ","black","hispan","married","nodegree","re74","re75","u74","u75")


# compute all interactions
X <- as.matrix(dat[,covars])
XX <- matrixmaker(X)


# prepare data: exclude non-sensical and co-linear vars, code treatment and outcome, change names
out <- c("black.black","nodegree.nodegree","nodegree.educ","married.married","hispan.hispan","hispan.black",
"u75.u75","u74.u74","u74.re74","u75.re75","u74.re74","u75.re75","re74.re74","re75.re75","re75.re74")


XX <- XX[,(colnames(XX) %in% out)==F]
dat <- data.frame(dat[,(names(dat) %in% covars)==F],XX)
covars <- names(dat)[-which((names(dat) %in% c("treat","re78")))]
X <- dat[,covars]
X <- as.matrix(X)
colnames(X) <-gsub(".age","*Age",colnames(X))
colnames(X) <-gsub(".educ*","*Schooling",colnames(X))
colnames(X) <-gsub(".black","*Black",colnames(X))
colnames(X) <-gsub(".hispan","*Hispanic",colnames(X))
colnames(X) <-gsub(".married","*Married",colnames(X))
colnames(X) <-gsub(".re74","*Earnings 1974",colnames(X))
colnames(X) <-gsub(".re75","*Earnings 1975",colnames(X))
colnames(X) <-gsub(".u74","*Unemployed 1974",colnames(X))
colnames(X) <-gsub(".u75","*Unemployed 1975",colnames(X))
colnames(X) <-gsub(".nodegree","*HS Dropout",colnames(X))
colnames(X) <-gsub("age","Age",colnames(X))
colnames(X) <-gsub("educ","Schooling",colnames(X))
colnames(X) <-gsub("black","Black",colnames(X))
colnames(X) <-gsub("hispan","Hispanic",colnames(X))
colnames(X) <-gsub("married","Married",colnames(X))
colnames(X) <-gsub("re74","Earnings 1974",colnames(X))
colnames(X) <-gsub("re75","Earnings 1975",colnames(X))
colnames(X) <-gsub("u74","Unemployed 1974",colnames(X))
colnames(X) <-gsub("u75","Unemployed 1975",colnames(X))
colnames(X) <-gsub("nodegree","HS Dropout",colnames(X))
dat <- data.frame(dat,X)
Y <- dat$re78
W <- dat$tr


#balance before matching
bout.nm <- MatchBalance(W~X,match.out = NULL,ks=FALSE)
bal.nm <- baltest.collect(matchbal.out=bout.nm ,var.names=colnames(X),after=FALSE)
round(bal.nm,3)


# Maha Dist Matching
mout.maha<-Match(Y,W,X,BiasAdjust=F,estimand="ATT",M=1)
summary(mout.maha)
bout.maha<- MatchBalance(W~X,match.out = mout.maha,ks=FALSE)
bal.maha <- baltest.collect(matchbal.out=bout.maha ,var.names=colnames(X),after=TRUE)
round(bal.maha,3)


# Genetic Matching ATT
g.weights <- GenMatch(Tr=W, X=X, BalanceMatrix=X, estimand="ATT", M=1,print.level=0)
mout.gm <-Match(Y,W,X,BiasAdjust=F,Weight.matrix=g.weights,estimand="ATT",M=1)
summary(mout.gm)
bout.gm <- MatchBalance(W~X,match.out = mout.gm,print.level=0,ks=FALSE)
bal.gm <- baltest.collect(matchbal.out=bout.gm,var.names=colnames(X),after=TRUE)
round(bal.gm,3)


## Logistic PS weighting + matching
PS<- glm(W~X,family=binomial(link=logit))$fitted
PSM <- PS
PS<- PS[W==0]
PS<- PS/(1-PS)


# PS Matching
mout.psm <-Match(Y,W,X=PSM,BiasAdjust=F,estimand="ATT",M=1)
summary(mout.psm)
bout.psm <- MatchBalance(W~X,match.out = mout.psm,print.level=0,ks=FALSE)
bal.psm<- baltest.collect(matchbal.out=bout.psm,var.names=colnames(X),after=TRUE)
round(bal.psm,3)


# PS Weighting
bout.psw <- MatchBalance(W~X,weights=c(W[W==1],PS),ks=FALSE)
bal.psw <- baltest.collect(matchbal.out=bout.psw,var.names=colnames(X),after=FALSE)
round(bal.psw,2)


# Entropy Balancing
out.eb <- ebalance(
Treatment=W,
X=X
)

bout.eb <- MatchBalance(W~X,weights=c(W[W==1],out.eb$w),ks=FALSE)
bal.eb<- baltest.collect(matchbal.out=bout.eb,var.names=colnames(X),after=F)
round(bal.eb,2)

# Entropy Balancing (with trimmed weights)
out.ebtr <- ebalance.trim(
ebalanceobj=out.eb,
)



    熟悉论坛请点击新手指南
下载说明
1、论坛支持迅雷和网际快车等p2p多线程软件下载,请在上面选择下载通道单击右健下载即可。
2、论坛会定期自动批量更新下载地址,所以请不要浪费时间盗链论坛资源,盗链地址会很快失效。
3、本站为非盈利性质的学术交流网站,鼓励和保护原创作品,拒绝未经版权人许可的上传行为。本站如接到版权人发出的合格侵权通知,将积极的采取必要措施;同时,本站也将在技术手段和能力范围内,履行版权保护的注意义务。
(如有侵权,欢迎举报)
二维码

扫码加我 拉你入群

请注明:姓名-公司-职位

以便审核进群资格,未注明则拒绝

GMT+8, 2025-12-31 16:25