Replacing NA values with mode from multiple imputation in R-CodePudding

I ran 5 imputations on a data set with missing values. For my purposes, I want to replace missing values with the mode from the 5 imputations. Let's say I have the following data sets, where df is my original data, ID is a grouping variable to identify each case, and imp is my imputed data:

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))

I have a method that works, but it involves a ton of manual coding as I have ~200 variables total (I'm doing this on 3 different data sets with different variables). My code looks like this for one variable:

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)

Thus, the original value in df is replaced with the mode only if the value was NA.

It is taking forever to keep manually coding this for every variable. I'm hoping there is an easier way of calculating the mode from the imputed data set for each variable by ID and then replacing the NAs with that mode in the original data. I thought maybe I could put the variable names in a vector and somehow iterate through them with one code where i changes to each variable name, but I didn't know where to go with that idea.

x <- colnames(df)

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

This is where I am stuck. Any help is much appreciated!

CodePudding user response：

Here is one option using tidyverse. Essentially, we can pivot both dataframes long, then join together and coalesce in one step rather than column by column. Mode function taken from 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")

Output

# 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

CodePudding user response：

You can use -

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 has Mode value for each of the var columns.
Join df and mode_data by ID.
Since all the pairs have name.x and name.y in their name, we can take all the name.x pairs replace x with y to get corresponding pair of columns. (.[[sub('x$', 'y', cur_column())]])
Use coalesce to select the non-NA value in each pair.
Change the column name by removing .x from the name. ({sub(".x$", "", .col)}) so var1.x becomes only var1.

where Mode function is taken from here

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

CodePudding user response：

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

^{Created on 2022-01-03 by the reprex package (v2.0.1)}

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