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

Replacing NA values with mode from multiple imputation in R

I 运行 对具有缺失值的数据集进行 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]])

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

这是一个使用 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

你可以使用-

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 列的模式值。
  • 通过ID加入dfmode_data
  • 由于所有对的名称中都有name.xname.y,我们可以将所有name.x对替换为y得到x对应的一对列。 (.[[sub('x$', 'y', cur_column())]])
  • 使用 coalesce 到 select 每对中的非 NA 值。
  • 通过从名称中删除 .x 来更改列名。 ({sub(".x$", "", .col)}) 所以 var1.x 只变成 var1.

其中 Mode 函数取自 here

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}
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)))]
}