使用线性模型填补缺失数据

3
我有一些类似于这样的数据。
   ID year       var1      var2
1   1    1         NA 0.5632595
2   1    2  0.7546097 0.5609945
3   1    3 -0.4241935        NA
4   1    4  0.4056908 0.5890453
5   2    1 -0.8049815 0.3504281
6   2    2  0.8049250 0.4817798
7   2    3         NA        NA
8   2    4 -0.2969572 0.4985812
9   3    1  0.2909882 0.8504004
10  3    2  1.0957994 0.7365867
11  3    3 -0.2884501 0.1454566
12  3    4  0.4999331 0.7978971

tmp <- structure(list(ID = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3), year = c(1L, 
2L, 3L, 4L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L), var1 = c(NA, 0.754609745086276, 
-0.424193528509845, 0.4056908200679, -0.804981499494056, 0.804924965958355, 
NA, -0.2969572255706, 0.29098820839828, 1.09579940195461, -0.288450063674258, 
0.499933144375212), var2 = c(0.563259549904615, 0.560994466999546, 
NA, 0.589045349741355, 0.350428087171167, 0.481779781170189, 
NA, 0.498581154504791, 0.850400378694758, 0.73658673488535, 0.145456639816985, 
0.797897139331326)), .Names = c("ID", "year", "var1", "var2"), row.names = c(NA, 
-12L), class = "data.frame")

我希望能够为每个ID适配每一列的线性模型,即:

tmp %>% group_by(ID) %>% lm(var1 ~ year, data = .)

tmp %>% group_by(ID) %>% lm(var2 ~ year, data = .)

我会使用这些模型的系数来填充每列中缺失的(NA)值。以ID1和Variable 1为例,我会有如下的一个模型:

coefs_id1_var1 <- coef(lm(var1 ~ year, data = tmp[tmp$ID == 1, ]))
coefs_id1_var1[1] + coefs_id1_var1[2] * tmp[1, 2]
[1] -0.1341153 

因此,ID 1变量1的缺失值将被替换为-0.134。我的问题是我有很多变量需要这样做。我考虑使用lapply并在ID上进行split,或者可能使用mutate_each,但是我还没有找到一种有效的方法来完成这个任务。有什么想法吗?

我目前的解决方案是

fillWithLinMod <- function(var, df) {
  mod <- as.formula(paste0(var, " ~ year"))
  coefs <- coef(lm(mod, data = df))
  for (i in 1:nrow(df)) {
    if (is.na(df[i, var])) {
      df[i, var] <- coefs[1] + df[i, "year"] * coefs[2]
    }
  }
  df[, var][[1]]
}

请注意,我的df是一个tibble,这就是为什么我在末尾有子集的原因。

然后我可以使用以下内容:

tmp$var1 <- do.call("c", lapply(split(tmp, tmp$ID), function(x) fillWithLinMod("var1", x)))

@Vlo 我不这么认为。我基本上已经完成了Intercept + year_Coef * Year_Number。 - nathaneastwood
不,对于每个ID,我希望为var1拟合一个线性模型,然后使用该模型来预测缺失的值。所以对于ID 1,在第一年缺失了var1的值。因此,模型将是Intercept + 1 * Slope。如果他们在第二年缺失了一个数据点,那么模型将是Intercept + 2 * Slope。 - nathaneastwood
我只是在使用 y = mx + c。 - nathaneastwood
2
这将为您提供var1的实例:tmp %>%split(。$ ID)%>%lapply(function(x)predict(lm(formula = var1〜year,x),x))%>%do.call(“c”,。) - agenis
是的,这是一种方法。我可以创建一个查找表,并使用这些数据填充原始数据框中的缺失数据,但如何一次性完成呢?而且对于多个列又该怎么办? - nathaneastwood
好的,问题已修复。 - nathaneastwood
1个回答

2

这是一个工作函数,您可以在子集中应用它。您需要传入一个数据框和一个要填充的字符向量变量名。它假定有一个名为“year”的变量,就像您在函数中所做的那样。

    fill_missing_with_lm <- function(dat, vars) {
      for(i in seq_along(vars)) {
        mod <- as.formula(paste0(vars[i], " ~ year"))
        mod <- lm(mod, dat)
        misses <- which(is.na(dat[[ vars[i] ]]))
        for(j in misses) {
          newdat <- data.frame(year = dat$year[j])
          dat[[ vars[i] ]][j] <- predict(mod, newdat)
        }
      }
      return(dat)
    }

然后您可以使用这个工作流程(嵌套数据框架)来应用它,我非常喜欢它。我发现它通常有助于处理数据,其中您想对数据的子集进行一些微妙的操作。基本原则是 group_by() %>% nest。然后您使用purrr::map()将您微妙的操作应用于每个嵌套数据框架。
    library(dplyr)
    library(tidyr)
    library(purrr)
    filled <- tmp %>%
      group_by(ID) %>%
      nest %>%
      mutate(filled = map(data, fill_missing_with_lm, vars = c('var1', 'var2'))) %>%
      select(ID, filled) %>%
      unnest

1
这看起来很不错 - 我会测试一下并告诉你结果。谢谢 - nathaneastwood

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接