r中dplyr的回归imputation

Question

我想做回归imputation与dplyr在R有效。这是我的问题:我有一个数据集，有许多缺失值对于一列，我们叫它p。现在我想用回归归算方法估计p的缺失值。为此，我用OLS对一组变量回归p使用未经审查的数据(p中没有缺失值的数据集的子集)。然后我用估计的系数来计算p的缺失值。

我的数据集看起来像这样:

df = data.frame(
id = c(1, 1, 1, 2, 2, 2),
group = c(1, 1, 2, 1, 1, 2),
sub_group = c(1, 2, 3, 1, 2, 3),
p = c(4.3, 5.7, NA, NA, NA, 10),
var1 = c(0.3, 0.1, 0.4, 0.9, 0.1, 0.2),
var2 = c(0, 0, 0, 1, 1, 1)
)

其中id代表个人，从subgroups(如"面包")的group(如"食物")处购买商品。p是价格，而var1和var2是一些人口统计变量(如"教育程度")。和"age"。

我已经做了什么:

library(dplyr)
df <- as_tibble(df)
# Create uncensored data
uncensored_df <- df %>%
filter(!is.na(p))
# Run regression on uncensored data
imp_model <- lm(p ~ var1 + var2, data = uncensored_df)
# Get the coefficients of the fitted model
coefs <- unname(imp_model$coefficients)
# Use coefficients to compute missing values of p
censored_df <-df %>%
filter(is.na(p)) %>%
group_by(id, group, sub_group) %>%
mutate(p = coefs[1] + coefs[2] * var1 + coefs[3] * var2)  
# And finally combine the two subsets                                 
bind_rows(uncensored_df, censored_df) %>% arrange(id, group, sub_group)                                     

由于我在实际问题(约30个变量)中使用var1和var2以上，使用dplyr进行回归imputation的更好方法是什么?(不过，我也对非dplyr解决方案持开放态度。)

Answer 1

library(dplyr)
fit <- lm(p ~ ., data = select(df, p, starts_with("var")))

df %>% 
rowwise() %>% 
mutate(p = ifelse(is.na(p), predict(fit, newdata = across()), p)) %>% 
ungroup()

工作原理

• 对于初学者来说，在拟合模型时，您可以使用select和任何tidyselect helper来选择您的因变量(这里使用starts_with("var"))。这个子集数据帧允许你使用~ .符号，这意味着在子集数据帧的所有内容上回归p。
• 接下来，您创建一个逐行数据框架，并使用您的模型来预测p缺失的位置。在本例中，across将每行转换为1x6的索引，您可以将其传递给newdata参数。predict然后使用模型拟合和这个新数据来预测p的值。

输出

id group sub_group     p  var1  var2
<dbl> <dbl>     <dbl> <dbl> <dbl> <dbl>
1     1     1         1  4.3    0.3     0
2     1     1         2  5.7    0.1     0
3     1     2         3  3.60   0.4     0
4     2     1         1  5.10   0.9     1
5     2     1         2 10.7    0.1     1
6     2     2         3 10      0.2     1

基准测试

---

正如在注释中提到的，对于大数据帧，逐行操作比其他选项花费的时间要长得多:

library(microbenchmark)
set.seed(1)
df1 <- df %>%
slice_sample(n = 1E5, replace = T)
fit <- lm(p ~ ., data = select(df1, p, starts_with("var")))

dplyr_rowwise <- function(){
df1 %>% 
rowwise() %>% 
mutate(p = ifelse(is.na(p), predict(fit, newdata = across()), p)) %>% 
ungroup()
}
dplyr_coalesce <- function(){
df1 %>%
mutate(p = coalesce(p, predict(fit, newdata = df1)))
}
base_index <- function(){
isna <- is.na(df1$p)
df1$p[isna] <- predict(fit, newdata = subset(df1, isna))
}
microbenchmark(
dplyr_rowwise(),
dplyr_coalesce(),
base_index(),
times = 10L
)
Unit: milliseconds
expr        min         lq        mean      median         uq  
dplyr_rowwise() 63739.9512 64441.0800 66926.46041 65513.51785 66923.0241
dplyr_coalesce()     6.5901     6.9037     8.55971     7.21125     7.7157
base_index()    13.0368    13.1790    15.73682    13.53310    19.3004