R 用线性回归填充缺失值

我有一个包含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_)

这工作非常好，但这需要花费太多的时间，因为我有很多数据帧，看起来像在文章中

我已经尝试过使用simputation软件包中的插补，但不幸的是，在填补数据空白之前，它似乎并不关心相关性最高的位置。以下是我写的：

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

---

这个怎么样？首先检查哪个传感器与传感器1最相关

corr <- sapply(c("sensor.2", "sensor.3", "sensor.4"), function(x) 
  cor(dat$sensor.1, dat[,x], use="complete.obs"))
#   sensor.2    sensor.3    sensor.4 
# 0.04397132  0.26880412 -0.06487781 

imp.use <- names(which.max(corr))
# [1] "sensor.3"

结果

---

玩具数据：

library（'MASS'））
种子（42）
M如果我理解正确，您要做的是基于
df$G1_d20_2014.SE14
为
df$G1_d20_2014.SE1
中的非缺失值建立一个线性模型，以填充
df$G1_d20_2014.SE1
中的缺失值。与其单独预测每个缺失的数据点，为什么不将其矢量化？例如，
mod这很好。然而，问题仍然是，我必须检查每个传感器的最高相关性。正如我所说的，对于一个数据帧来说这不是问题，但我有74个其他数据帧，其中一些包含48个传感器的数据，像这样手动操作需要很长时间。我想知道是否有可能为每个传感器编写一个自动获取最高相关性的函数，然后自己执行上述操作。只需将其包装成一个函数
impFUN我知道这是很久以前的事了，但我遇到了一个问题。由于您的解决方案仅使用相关性最高的传感器来“填充”间隙，因此如果另一个传感器与我要填充的传感器在同一位置存在数据间隙，则会出现问题。你知道如何在代码中设定一个条件，即如果第一个传感器无法填补间隙，那么它将采用相关性第二高的传感器，然后是第三个传感器，依此类推……？我知道如何计算第二个最大值（见下面的代码），但我不知道如何在代码中实现这一点。如果你能帮我，那就太好了<代码>l=长度（corr）
和
secondmax
      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_)

    }

corr <- sapply(c("sensor.2", "sensor.3", "sensor.4"), function(x) 
  cor(dat$sensor.1, dat[,x], use="complete.obs"))
#   sensor.2    sensor.3    sensor.4 
# 0.04397132  0.26880412 -0.06487781 

imp.use <- names(which.max(corr))
# [1] "sensor.3"

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

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