如何编写for循环以从包含NA的数据集中计算模型残差?

时间:2019-10-17 18:38:14

标签: r

我有一个针对不同位置的数据集,在这里我测量了不同日期的响应变量。我需要拟合线性模型并计算每个位置级别的残差。这是针对我的情况的模拟数据集。

#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

有人可以在这里给我一些建议吗?

非常感谢。

1 个答案:

答案 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)))