用线性回归填充缺失值

时间:2020-05-12 10:02:50

标签: r imputation

我有一个包含7列的数据框。

 str(df)

'data.frame':   8760 obs. of  7 variables:
 $ G1_d20_2014.SE1_ : num  25.1 25.1 25 25 25.1 ...
 $ G1_d20_2014.SE4_ : num  42.4 42.3 42.3 42.3 42.3 ...
 $ G1_d20_2014.SE7_ : num  34.4 34.4 34.4 34.4 34.4 ...
 $ G1_d20_2014.SE22_: num  42.5 42.4 42.3 42.4 42.3 ...
 $ G1_d20_2014.SE14_: num  52.5 52.5 52.5 52.5 52.4 ...
 $ G1_d20_2014.SE26 : num  40.8 40.8 40.8 40.8 40.8 ...

每个列代表一个唯一的传感器,并且这些列包含来自传感器的测量数据。一些列包含缺少的值。我想通过线性回归填补每一列的数据空白。我已经手动完成此操作,但是有一个非常重要的条件,我正在寻找一个可以单独执行此操作的函数,因为所有列都需要花费太多时间来执行此操作。条件如下: 假设G1_d20_2014_SE1包含丢失的数据。 然后我想用相关系数最高的另一个传感器的完整数据集来填补该传感器的数据空白

这是我手动执行的操作:

我创建了一个创建指标变量的函数。如果值不是NA,则指示器变量将变为1;如果值不是NA,则指示器变量将变为0。然后,我将此变量作为列添加到数据集中:

Indvar <- function(t) {

  x <- dim(length(t))
  x[which(!is.na(t))] = 1
  x[which(is.na(t))] = 0 
  return(x)
}

df$I <- Indvar(df$G1_d20_2014.SE1_)

接下来,我查看了相关系数最高的传感器和传感器1之间(在这种情况下,SE1和SE14之间的相关系数最高)。然后,我计算了线性回归,从中取出方程式,并将其放入for循环中,只要指标变量为0,该循环便根据方程式填充NA值:

lm(df$G1_d20_2014.SE1_ ~ df$G1_d20_2014.SE14_, data = df)

for (i in 1:nrow(df)) {

  if (df$I[i] == 0)

  {

    df$G1_d20_2014.SE1_[i] = 8.037 + 0.315*df$G1_d20_2014.SE14_[i]
  }
}

这工作得很好,但是这样做花了很多时间,因为我有很多数据框看起来像后面的数据框。

我已经尝试过使用simputation包中的impute_lm,但是不幸的是,在填补数据空白之前,它似乎并不关心相关性最高的位置。这是我写的:

impute_fun <- impute_lm(df, 
    formula = SE1_ + SE4_ ~ SE14_ + SE26)

当我写SE14_ + SE26_时,我检查了他是否使用SE14中的值来估算SE1中的值,但他没有使用,因为结果与我的手动结果不同。

有没有我想要的功能?我真的很沮丧,因为我已经找了两个多星期了。我真的非常感谢您的帮助!

编辑/回答@ jay.sf

所以我试图用它来制作一个函数(如下),但是我遇到了一些麻烦:

我不知道如何在函数中为每一列指定该函数,并且它会从sapply(c(“ SE1 _”,“ SE2_ “,...)因为显然,如果我对SE1_执行此操作,而SE1_仍在代码中,则相关性将为1,并且什么也不会发生。行cor(df $ SE1_,df [,x],use =“ complete.obs”)),因为它在这里说df $ SE1_。与df $ SE1_imp <-...行相同。 当然,我可以只从sapply(...)代码中删除传感器,这样就不会出现第一个问题。我只是想知道是否有更好的方法可以做到这一点。对于df $ SE1_部分也是如此,如果我想估算SE2_的值,则必须将df $ SE1_更改为df $ SE2_,依此类推。

我试图运行这样的代码(但当然没有sapply(...)中的SE1_),但出现错误:df [,x]中的错误:尺寸错误。 有什么想法可以解决这些问题吗?

      impFUN <- function(df) {

      corr <- sapply(c("SE1_", "SE2_", "SE4_", "SE5_","SE6_",                      
                      "SE7_", "SE12_", "SE13_","SE14_", "SE15_",
                      "SE16_", "SE22_","SE23", "SE24", "SE25",
                      "SE26",  "SE33", "SE34", "SE35", "SE36",
                      "SE37", "SE46", "SE51", "SE52", "SE53",
                      "SE54", "SE59", "SE60", "SE61", "SE62", 
                      "SE68", "SE69", "SE70", "SE71", "SE72", 
                      "SE73","SE74", "SE82", "SE83", "SE84", 
                      "SE85", "SE86", "SE87", "SE99","SE100", 
                      "SE101", "SE102", "SE103","SE104", 
                      "SE106", "SE107","SE121"),  function(x)
                  cor(df$SE1_, df[, x], use = "complete.obs")) 

      imp.use <- names(which.max(corr)) 

      regr.model <- lm(reformulate(imp.use, "SE1_"))

      df$SE1_imp <- 
          ifelse(is.na(df$SE1_), lm.cf[1] + df[[imp.use]]*lm.cf[2], df$SE1_)

    }

1 个答案:

答案 0 :(得分:1)

那呢?首先检查哪个传感器与传感器1最相关。

lm.cf <- lm(reformulate(imp.use, "sensor.1"), dat)$coef

计算回归模型,

ifelse

要估算传感器1,请使用dat$sensor.1.imp <- ifelse(is.na(dat$sensor.1), lm.cf[1] + dat[[imp.use]]*lm.cf[2], dat$sensor.1) 中的系数,如下所示:

head(dat)
#     sensor.1   sensor.2   sensor.3    sensor.4 sensor.1.imp
# 1  2.0348728 -0.6374294  2.0005714  0.03403394    2.0348728
# 2 -0.8830567 -0.8779942  0.7914632 -0.66143678   -0.8830567
# 3         NA  1.2481243 -0.9897785 -0.36361831   -0.1943438
# 4         NA -0.1162450  0.6672969 -2.84821295    0.2312968
# 5  1.0407590  0.1906306  0.3327787  1.16064011    1.0407590
# 6  0.5817020 -0.6133034  0.5689318  0.71543751    0.5817020

结果

library('MASS')
set.seed(42)
M <- mvrnorm(n=1e2, mu=c(0, 0, 0, 0), 
             Sigma=matrix(c(1, .2, .3, .1,
                            .2, 1, 0, 0, 
                            .3, 0, 1, 0,
                            .1, 0, 0, 1), nrow=4),
             empirical=TRUE)
dat <- as.data.frame(`colnames<-`(M, paste0("sensor.", 1:4)))
dat[sample(1:nrow(dat), 30), "sensor.1"] <- NA  ## generate 30% missings

玩具数据:

.ace_cursor {
    animation: none!important
}