用 R 中多重插补的模式替换 NA 值

Question

我对缺失值的数据集进行了 5 次插补。出于我的目的，我想用 5 个插补中的模式替换缺失值。假设我有以下数据集，其中 df 是我的原始数据，ID 是用于识别每个案例的分组变量，imp 是我的估算数据：

df <- data.frame(ID = c(1,2,3,4,5), 
                 var1 = c(1,NA,3,6,NA),
                 var2 = c(NA,1,2,6,6),
                 var3 = c(NA,2,NA,4,3))

imp <- data.frame(ID = c(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5,5,5,5,5), 
                 var1 = c(1,2,3,3,2,5,4,5,6,6,7,2,3,2,5,6,5,6,6,6,3,1,2,3,2),
                 var2 = c(4,3,2,3,2,4,6,5,4,4,7,2,4,2,3,6,5,6,4,5,3,3,4,3,2),
                 var3 = c(7,6,5,6,6,2,3,2,4,2,5,4,5,3,5,1,2,1,3,2,1,2,1,1,1))

我有一个可行的方法，但它涉及大量手动编码，因为我总共有大约 200 个变量（我在 3 个具有不同变量的不同数据集上执行此操作）。对于一个变量，我的代码如下所示：

library(dplyr)

mode <- function(codes){
  which.max(tabulate(codes))
}

var1 <- imp %>% group_by(ID) %>% summarise(var1 = mode(var1))

df3 <- df %>% 
  left_join(var1, by = "ID") %>% 
  mutate(var1 = coalesce(var1.x, var1.y)) %>% 
  select(-var1.x, -var1.y)

因此，只有当值为 NA 时，df 中的原始值才会被模式替换。

为每个变量手动编码需要很长时间。我希望有一种更简单的方法可以通过 ID 从每个变量的估算数据集中计算模式，然后在原始数据中用该模式替换 NA。我想也许我可以把变量名放在一个向量中，并以某种方式用一个代码迭代它们，在其中我更改每个变量名，但我不知道该去哪里。

x <- colnames(df)

# Attempting to iterate through variables names using i
i = as.factor(x[[2]])

这就是我卡住的地方。非常感谢任何帮助！

Answer 1

这是使用tidyverse 的一个选项。本质上，我们可以长时间旋转两个数据帧，然后一步连接在一起并coalesce，而不是逐列。 Mode 函数取自 here。

library(tidyverse)

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

imp_long <- imp %>%
  group_by(ID) %>%
  summarise(across(everything(), Mode)) %>%
  pivot_longer(-ID)

df %>%
  pivot_longer(-ID) %>%
  left_join(imp_long, by = c("ID", "name")) %>%
  mutate(var1 = coalesce(value.x, value.y)) %>%
  select(-c(value.x, value.y)) %>%
  pivot_wider(names_from = "name", values_from = "var1")

输出

# A tibble: 5 × 4
     ID  var1  var2  var3
  <dbl> <dbl> <dbl> <dbl>
1     1     1     3     6
2     2     5     1     2
3     3     3     2     5
4     4     6     6     4
5     5     3     6     3

Answer 2

你可以使用 -

library(dplyr)

mode_data <- imp %>% 
  group_by(ID) %>% 
  summarise(across(starts_with('var'), Mode))

df %>%
  left_join(mode_data, by = 'ID') %>%
  transmute(ID, 
            across(matches('\\.x$'), 
            function(x) coalesce(x, .[[sub('x$', 'y', cur_column())]]), 
            .names = '{sub(".x$", "", .col)}'))

#  ID var1 var2 var3
#1  1    1    3    6
#2  2    5    1    2
#3  3    3    2    5
#4  4    6    6    4
#5  5    3    6    3

• mode_data 的每个 var 列都有 Mode 值。
• 通过ID 加入df 和mode_data。
• 由于所有对的名称中都有name.x 和name.y，我们可以将所有name.x 对替换为x 与y 以获得对应的列对。 (.[[sub('x$', 'y', cur_column())]])
• 使用coalesce 选择每对中的非NA 值。
• 通过从名称中删除 .x 来更改列名称。 ({sub(".x$", "", .col)}) 所以var1.x 变成了只有var1。

其中Mode函数取自here

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

Answer 3

library(dplyr, warn.conflicts = FALSE)

imp %>% 
  group_by(ID) %>% 
  summarise(across(everything(), Mode)) %>% 
  bind_rows(df) %>% 
  group_by(ID) %>% 
  summarise(across(everything(), ~ coalesce(last(.x), first(.x))))
#> # A tibble: 5 × 4
#>      ID  var1  var2  var3
#>   <dbl> <dbl> <dbl> <dbl>
#> 1     1     1     3     6
#> 2     2     5     1     2
#> 3     3     3     2     5
#> 4     4     6     6     4
#> 5     5     3     6     3

^{由reprex package (v2.0.1) 于 2022-01-03 创建}

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}