我有一个针对不同位置的数据集,在这里我测量了不同日期的响应变量。我需要拟合线性模型并计算每个位置级别的残差。这是针对我的情况的模拟数据集。
#dataframe
loc <- c("Loc1", "Loc2", "Loc3", "Loc4")
day <- as.numeric(c(1, 14, 20, 31, 37, 59))
empty <- expand.grid(loc, day)
empty <- empty %>% arrange(Var1,Var2)
response <- as.numeric(c(4398,NA, 6000.00,9234,11680,12395
,2000,4273,8000,NA,NA,12762
,2300,4000.00,5161,8682,12000.00,13388
,NA,6225,6547,9441,7999,8688))
resp.data <- cbind(empty, response)
names(resp.data) <- c("loc", "day", "response")
这就是我所做的。
# run loop to calculate residuals from a linear fit
residuals <- as.data.frame(matrix(nrow = 6, ncol = 4))
for (i in seq_along(unique(resp.data$loc))) {
data_loc <- resp.data %>% filter(loc == unique(resp.data$loc)[i])
model_loc <- lm(data = data_loc,
response ~ day)
temp <- c(resid(model_loc))
if (length(temp)<6){
temp <- c(rep('na',6-length(temp)), temp)
}
residuals[i] <- temp
}
我的问题是,观测数据具有一些NA,因此我将无法为该特定观测值计算残差。我提供了一个解决方案,但是如果不起作用,因为残差的NA与观察到的数据的NA不匹配。这是我的结果。
# getting the final dataset with the residuals
residuals <- residuals %>% rename_at(vars(names(residuals)), ~ unique(resp.data$loc)) %>%
gather(key = "loc", value = "res")
resp.data$res <- residuals$res
loc day response res
1 Loc1 1 4398 na
2 Loc1 14 NA 35.7766491917869
3 Loc1 20 6000 -1271.46657929227
4 Loc1 31 9234 278.234709480122
5 Loc1 37 11680 1805.52632153779
6 Loc1 59 12395 -848.071100917431
7 Loc2 1 2000 na
8 Loc2 14 4273 na
9 Loc2 20 8000 -672.182985553773
10 Loc2 31 NA -760.310593900481
11 Loc2 37 NA 1876.93820224719
12 Loc2 59 12762 -444.444622792938
13 Loc3 1 2300 274.745821042281
14 Loc3 14 4000 -806.877089478858
15 Loc3 20 5161 -929.703048180924
16 Loc3 31 8682 237.616027531956
17 Loc3 37 12000 2271.79006882989
18 Loc3 59 13388 -1047.57177974435
19 Loc4 1 NA na
20 Loc4 14 6225 -561.709846254499
21 Loc4 20 6547 -567.168138698069
22 Loc4 31 9441 1726.49165848872
23 Loc4 37 7999 -42.9666339548574
24 Loc4 59 8688 -554.647039581289
有人可以在这里给我一些建议吗?
非常感谢。
答案 0 :(得分:1)
1)对于每个子集,使用na.action = na.exclude
执行回归,计算其残差,将其附加到该子集,然后将所有内容放回去。
library(dplyr)
resp.data %>%
group_by(loc) %>%
do(mutate(., resid = resid(lm(response ~ day, ., na.action = na.exclude)))) %>%
ungroup
2)或不使用dplyr:
do.call("rbind", by(resp.data, resp.data$loc, function(x) {
cbind(x, resid = resid(lm(response ~ day, x, na.action = na.exclude)))
}))
3)另一种方法是计算残差然后附加它们。它可以在这里工作,但可能会更脆弱,因为它假定计算的残差矢量与输入数据帧的顺序相同。
reg.list <- by(resp.data, resp.data$loc, lm, formula = response ~ day,
na.action = na.exclude)
transform(resp.data, resid = c(sapply(reg.list, resid)))