plm:使用fixef()手动计算固定效果twoways模型的拟合值

时间:2013-10-06 14:02:17

标签: r plm

请注意:我正在尝试使用 时间&单个固定效果和不平衡数据集。下面的示例代码使用平衡数据集。

请参阅下面的编辑,

我正在尝试使用plm包手动计算固定效果模型的拟合值(包括个体和时间效果)。这更像是一个练习,以确认我理解模型和包的机制,我知道我可以从plm对象中获取拟合值,来自两个相关问题(here和{ {3}})。

plm小插曲(第2页),基础模型是:

y _it = alpha + beta _transposed * x _it +( mu _i + lambda _t + epsilon _it)

其中mu_i是错误术语的单个组成部分(a.k.a。“个别效果”),lambda_t是“时间效应”。

可以使用fixef()提取固定效果,我认为我可以使用它们(连同自变量)来计算模型的拟合值,使用(使用两个独立变量):

适合 _it = alpha + beta _1 * x1 + beta _2 * x2 + mu _i + lambda _t

这是我失败的地方 - 我得到的值远不及拟合值(我得到的是实际值与模型对象中残差之间的差异)。首先,我在任何地方都看不到alpha。我尝试使用固定效果显示为与第一个,平均值等不同,但没有成功。

我缺少什么?它很可能是对模型的误解,或代码中的错误,我担心...提前感谢。

PS:其中一个相关问题暗示pmodel.response()应与我的问题相关(以及没有plm.fit函数的原因),但其帮助页面无法帮助我理解这个函数是什么实际上,我找不到任何例子来解释它产生的结果。

谢谢!

我所做的示例代码:

library(data.table); library(plm)

set.seed(100)
DT <- data.table(CJ(id=c("a","b","c","d"), time=c(1:10)))
DT[, x1:=rnorm(40)]
DT[, x2:=rnorm(40)]
DT[, y:=x1 + 2*x2 + rnorm(40)/10]
DT <- DT[!(id=="a" & time==4)] # just to make it an unbalanced panel
setkey(DT, id, time)

summary(plmFEit <- plm(data=DT, id=c("id","time"), formula=y ~ x1 + x2, model="within", effect="twoways"))

# Extract the fitted values from the plm object
FV <- data.table(plmFEit$model, residuals=as.numeric(plmFEit$residuals))
FV[, y := as.numeric(y)]
FV[, x1 := as.numeric(x1)]
FV[, x2 := as.numeric(x2)]

DT <- merge(x=DT, y=FV, by=c("y","x1","x2"), all=TRUE)
DT[, fitted.plm := as.numeric(y) - as.numeric(residuals)]

FEI <- data.table(as.matrix(fixef(object=plmFEit, effect="individual", type="level")), keep.rownames=TRUE) # as.matrix needed to preserve the names?
setnames(FEI, c("id","fei"))
setkey(FEI, id)
setkey(DT, id)
DT <- DT[FEI] # merge the fei into the data, each id gets a single number for every row

FET <- data.table(as.matrix(fixef(object=plmFEit, effect="time", type="level")), keep.rownames=TRUE) # as.matrix needed to preserve the names?
setnames(FET, c("time","fet"))
FET[, time := as.integer(time)] # fixef returns time as character
setkey(FET, time)
setkey(DT, time)
DT <- DT[FET] # merge the fet into the data, each time gets a single number for every row

# calculate the fitted values (called calc to distinguish from those from plm)
DT[, fitted.calc := as.numeric(coef(plmFEit)[1] * x1 + coef(plmFEit)[2]*x2 + fei + fet)]
DT[, diff := as.numeric(fitted.plm - fitted.calc)]

all.equal(DT$fitted.plm, DT$fitted.calc)

我的会议如下:

R version 3.2.2 (2015-08-14)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 8 x64 (build 9200)

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252 LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] plm_1.4-0           Formula_1.2-1       RJSONIO_1.3-0       jsonlite_0.9.17     readxl_0.1.0.9000   data.table_1.9.7    bit64_0.9-5         bit_1.1-12          RevoUtilsMath_3.2.2

loaded via a namespace (and not attached):
 [1] bdsmatrix_1.3-2  Rcpp_0.12.1      lattice_0.20-33  zoo_1.7-12       MASS_7.3-44      grid_3.2.2       chron_2.3-47     nlme_3.1-122     curl_0.9.3       rstudioapi_0.3.1 sandwich_2.3-4  
[12] tools_3.2.2  

编辑:(2015-02-22) 由于这引起了一些兴趣,我将进一步澄清。我试图拟合一个“固定效应”模型(又名“内部”或“最小二乘虚拟变量”,因为here在第3页上调用它,上段) - 相同的斜率,不同拦截。

这与为timeid添加虚拟对象后运行普通OLS回归相同。使用下面的代码,我可以使用基础plm复制lm()包中的拟合值。使用假人,明确的是id和time的第一个元素是要比较的组。我仍然不能做的是如何使用plm包的设施做同样的事情我可以使用lm()轻松完成。

# fit the same with lm() and match the fitted values to those from plm()
lmF <- lm(data = DT, formula = y ~ x1 + x2 + factor(time) + factor(id))
time.lm <- coef(lmF)[grep(x = names(coef(lmF)), pattern = "time", fixed = TRUE)]
time.lm <- c(0, unname(time.lm)) # no need for names, the position index corresponds to time

id.lm <- coef(lmF)[grep(x = names(coef(lmF)), pattern = "id", fixed = TRUE)]
id.lm <- c(0, unname(id.lm))
names(id.lm) <- c("a","b","c","d") # set names so that individual values can be looked up below when generating the fit

DT[, by=list(id, time), fitted.lm := coef(lmF)[["(Intercept)"]]  +  coef(lmF)[["x1"]] * x1  +  coef(lmF)[["x2"]] * x2  +  time.lm[[time]]  +  id.lm[[id]]]
all.equal(DT$fitted.plm, DT$fitted.lm)

希望这对可能感兴趣的其他人有用。问题可能是plmfixef如何处理我故意创建的缺失值。我尝试使用type=的{​​{1}}参数进行播放但不起作用。

4 个答案:

答案 0 :(得分:1)

我发现这可以帮助你,因为lm()解决方案在我的情况下不起作用(与plm包相比,我得到了不同的系数)

因此,这只是在这里应用plm包的作者提出的建议http://r.789695.n4.nabble.com/fitted-from-plm-td3003924.html

所以我所做的只是申请

plm.object <- plm(y ~ lag(y, 1) + z +z2, data = mdt, model= "within", effect="twoways")
fitted <- as.numeric(plm.object$model[[1]] - plm.object$residuals) 

我需要as.numeric函数,因为我需要将它用作插入的矢量以进行进一步的操作。我还想指出,如果你的模型在右侧有一个滞后因变量,上面的as.numeric解决方案提供了一个由于滞后而已经缺失值的NET。对我而言,这正是我所需要的。

答案 1 :(得分:1)

适用于effect="individual"和时间虚拟y ~ x +factor(year)的不平衡数据:

fitted <- pmodel.response(plm.model)-residuals(plm.model)

答案 2 :(得分:1)

我越来越接近Helix123建议减去within_intercept(它包含在两个固定效果的每一个中,所以你需要纠正它)。

我的重建错误中有一个非常具有暗示性的模式:个人a始终关闭-0.004858712(每个时间段)。个人b, c, d对于每个时间段总是关闭0.002839703,除了在第4期(其中没有a的观察值),其中它们被关闭-0.010981192。< / p>

有什么想法吗?看起来单独的固定效果会因不平衡而被抛弃。重新运行它可以正常工作。

完整代码:

DT <- data.table(CJ(id=c("a","b","c","d"), time=c(1:10)))
DT[, x1:=rnorm(40)]
DT[, x2:=rnorm(40)]
DT[, y:= x1 + 2*x2 + rnorm(40)/10]
DT <- DT[!(id=="a" & time==4)] # just to make it an unbalanced panel
setkey(DT, id, time)

plmFEit <- plm(formula=y ~ x1 + x2,
               data=DT,
               index=c("id","time"),
               effect="twoways",
               model="within")

summary(plmFEit)

DT[, resids := residuals(plmFEit)]

FEI <- data.table(as.matrix(fixef(plmFEit, effect="individual", type="level")), keep.rownames=TRUE) # as.matrix needed to preserve the names?
setnames(FEI, c("id","fei"))
setkey(FEI, id)
setkey(DT, id)
DT <- DT[FEI] # merge the fei into the data, each id gets a single number for every row

FET <- data.table(as.matrix(fixef(plmFEit, effect="time", type="level")), keep.rownames=TRUE) # as.matrix needed to preserve the names?
setnames(FET, c("time","fet"))
FET[, time := as.integer(time)] # fixef returns time as character
setkey(FET, time)
setkey(DT, time)
DT <- DT[FET] # merge the fet into the data, each time gets a single number for every row

DT[, fitted.calc := plmFEit$coefficients[[1]] * x1 + plmFEit$coefficients[[2]] * x2 +
     fei + fet - within_intercept(plmFEit)]

DT[, myresids := y - fitted.calc]
DT[, myerr := resids - myresids]

答案 3 :(得分:0)

这是你想要的吗? 通过fixef提取固定效果,并将它们与单个索引匹配。以下是Grunfeld数据的示例:

data(Grunfeld, package = "plm")
fe <- plm(inv ~ value + capital, data=Grunfeld, model = "within")

temp <- merge(Grunfeld, data.frame(fixef_firm = names(fixef(fe)), fixef = as.numeric(fixef(fe))), all.x =T, by.x = c("firm"), by.y=c("fixef_firm"))
fitted_by_hand <- temp$fixef + fe$coefficients[1] * Grunfeld$value +  fe$coefficients[2] * Grunfeld$capital

fitted <- fe$model[ , 1] - fe$residuals

# just to remove attributs and specific classes 
fitted_by_hand <- as.numeric(fitted_by_hand)
fitted <- as.numeric(fitted)

all.equal(fitted, fitted_by_hand) # TRUE
cbind(fitted, fitted_by_hand) # see yourself