按组应用分组模型

Question

我的问题与this one 非常相似，但我面临的问题有一个转折点，这些答案没有解决。具体来说，我正在估计一个空间模型y=rho * lw * y + X *beta。因为观察与矩阵lw 相关，所以我必须同时将模型应用于整个X 矩阵。因为这些答案是按行操作的，所以它们不适用。

这是 MWE 数据，由三组中的 20 个点和一个空间权重矩阵组成：

library(spdep)
#Coordinates
pointcoords <- data.frame(x = runif(n=20, min =10, max = 100), y = runif(n=20, min = 10, max = 100), ID = as.character(1:20))
pointsSP <- SpatialPoints(pointcoords[,1:2])
# Weights matrix
lw <- nb2listw(knn2nb(knearneigh(pointsSP, k = 4, RANN = FALSE), 
                      row.names = pointcoords$ID))

# Data
MyData <- data.frame(ID = rep(1:20, each = 3),
                     Group = rep(1:3, times = 20),
                     DV = rnorm(60),IV = rnorm(60))

我可以通过Group 和dplyr 估计模型

library(dplyr)
models <- MyData %>% group_by(Group) %>% 
  do(lm = lm(DV ~ IV, data = .), 
     sar = lagsarlm(DV ~ IV, data = ., listw = lw))

使用this answer 预测新数据以逐行方式运行，对lm 对象运行良好，

MyData2 <- data.frame(ID = rep(1:20, each = 3),
                      Group = rep(1:3, times = 20),
                      IV = rnorm(60))

MyData2 %>% left_join(models) %>% rowwise %>%
  mutate(lmPred = predict(lm, newdata = list("IV" = IV))) %>% head()
#Joining by: "Group"
#Source: local data frame [6 x 6]
#Groups: 

#  ID Group         IV      lm        sar      lmPred
#1  1     1 -0.8930794 <S3:lm> <S3:sarlm> -0.21378814
#2  1     2 -1.6637963 <S3:lm> <S3:sarlm>  0.42547796
#3  1     3  0.5243841 <S3:lm> <S3:sarlm> -0.23372996
#4  2     1 -0.1956969 <S3:lm> <S3:sarlm> -0.20860280
#5  2     2  0.8149920 <S3:lm> <S3:sarlm>  0.14771431
#6  2     3 -0.3000439 <S3:lm> <S3:sarlm>  0.05082524

但不适用于sar 型号：

MyData2 %>% left_join(models) %>% rowwise %>%
  mutate(sarPred = predict(sar, newdata = list("IV" = IV), listw=lw)) %>% head()
#Joining by: "Group"
#Error in if (nrow(newdata) != length(listw$neighbours)) stop("mismatch between newdata and spatial weights") : 
  argument is of length zero

我认为应该有更好的方法来做到这一点，而无需将模型加入每一行。此外，如果您有多个或更改预测变量，则为 newdata 创建列表对象将不起作用。看来dplyr的方式应该是这样的：

MyData2 %>% group_by(Group) %>%
  mutate(sarPred = predict(models$sar[[Group]],  newdata = ., listw=lw))

但[[Group]] 索引不太正确。

Answer 1

我最终在dplyr 中使用do 执行此操作，逐行遍历models data.frame。我相信它可以满足您的需求，尽管输出不包含用于预测的新数据。不过，我确实在输出中添加了Group，因为似乎有必要将组分开。

models %>%
    do(data.frame(Group = .$Group, 
                predlm = predict(.$lm, newdata = filter(MyData2, Group == .$Group)), 
                predsar = predict(.$sar, newdata = filter(MyData2, Group == .$Group) , listw = lw)))

编辑

尝试将解释变量添加到输出 data.frame 中。以下是可行的，尽管可能有更好的方法来做到这一点。

models %>%
    do(data.frame(Group = .$Group, IV = select(filter(MyData2, Group == .$Group), IV),
                predlm = predict(.$lm, newdata = filter(MyData2, Group == .$Group)), 
                predsar = predict(.$sar, newdata = filter(MyData2, Group == .$Group) , listw = lw)))

Answer 2

我把它放在那里是因为它确实做我想做的事，即使它需要使用 for 循环（喘气）

predictobj <- list()
for(i in models$Group){
  predictobj[[i]] <- predict.sarlm(models$sar[[i]], 
                                   newdata = filter(MyData2, Group == i),
                                   listw = lw)
}

有人有dplyr 的解决方案吗？