R语言 小鼠多重插补的并行计算

xriantvc  于 2023-07-31  发布在  其他
关注(0)|答案(2)|浏览(102)

我想在R中使用mice运行150次多重插补。然而,为了保存一些计算时间,我想将进程细分为并行流(正如Stef货车Buuren在“Flexible Importation for Missing Data”中所建议的那样)。
我的问题是:怎么做?
我可以想象两种选择:
选项1:

imp1<-mice(data, m=1, pred=quicktry, maxit=15, seed=1)
imp2<-mice(data, m=1, pred=quicktry, maxit=15, seed=1)
imp...<-mice(data, m=1, pred=quicktry, maxit=15, seed=1)
imp150<-mice(data, m=1, pred=quicktry, maxit=15, seed=1)

字符串
然后使用completeas.mids将插补组合在一起
选项2:

imp1<-mice(data, m=1, pred=quicktry, maxit=15, seed=VAL_1to150)
imp2<-mice(data, m=1, pred=quicktry, maxit=15, seed=VAL_1to150)
imp...<-mice(data, m=1, pred=quicktry, maxit=15, seed=VAL_1to150)
imp150<-mice(data, m=1, pred=quicktry, maxit=15, seed=VAL_1to150)


通过添加VAL_1to150,否则在我看来(我可能错了),如果它们都使用相同的数据集和相同的种子运行,您将获得150倍的相同结果。
还有其他选择吗
谢啦,谢啦

ztmd8pv5

ztmd8pv51#

所以主要的问题是组合估算,正如我所看到的,有三种选择,使用ibindcomplete,或者试图保持mids结构。我强烈建议使用ibind解决方案。其他的答案留给那些好奇的人。

获取并行结果

在做任何事情之前,我们需要得到平行小鼠的插补。并行部分相当简单,我们需要做的就是使用并行包,并确保使用clusterSetRNGStream设置种子:

library(parallel)
# Using all cores can slow down the computer
# significantly, I therefore try to leave one
# core alone in order to be able to do something 
# else during the time the code runs
cores_2_use <- detectCores() - 1

cl <- makeCluster(cores_2_use)
clusterSetRNGStream(cl, 9956)
clusterExport(cl, "nhanes")
clusterEvalQ(cl, library(mice))
imp_pars <- 
  parLapply(cl = cl, X = 1:cores_2_use, fun = function(no){
    mice(nhanes, m = 30, printFlag = FALSE)
  })
stopCluster(cl)

字符串
以上将产生cores_2_use * 30插补数据集。

使用ibind

正如@AleksanderBlekh所建议的那样,mice::ibind可能是最好,最直接的解决方案:

imp_merged <- imp_pars[[1]]
for (n in 2:length(imp_pars)){
  imp_merged <- 
    ibind(imp_merged,
          imp_pars[[n]])
}

使用foreachibind

也许最简单的替代方案是使用foreach

library(foreach)
library(doParallel)
cl <- makeCluster(cores_2_use)
clusterSetRNGStream(cl, 9956)
registerDoParallel(cl)

library(mice)
imp_merged <-
  foreach(no = 1:cores_2_use, 
          .combine = ibind, 
          .export = "nhanes",
          .packages = "mice") %dopar%
{
  mice(nhanes, m = 30, printFlag = FALSE)
}
stopCluster(cl)

使用complete

使用complete(..., action="long")rbind提取完整的数据集,然后使用as.mids其他mice对象可能工作得很好,但它生成的对象比其他两种方法更苗条:

merged_df <- nhanes
merged_df <- 
  cbind(data.frame(.imp = 0,
                   .id = 1:nrow(nhanes)),
        merged_df)
for (n in 1:length(imp_pars)){
  tmp <- complete(imp_pars[[n]], action = "long")
  tmp$.imp <- as.numeric(tmp$.imp) + max(merged_df$.imp)
  merged_df <- 
    rbind(merged_df,
          tmp)
}

imp_merged <- 
  as.mids(merged_df)

# Compare the most important the est and se for easier comparison
cbind(summary(pool(with(data=imp_merged,
                        exp=lm(bmi~age+hyp+chl))))[,c("est", "se")],
      summary(pool(with(data=mice(nhanes, 
                                  m = 60, 
                                  printFlag = FALSE),
                        exp=lm(bmi~age+hyp+chl))))[,c("est", "se")])


给出输出:

est         se         est         se
(Intercept) 20.41921496 3.85943925 20.33952967 3.79002725
age         -3.56928102 1.35801557 -3.65568620 1.27603817
hyp          1.63952970 2.05618895  1.60216683 2.17650536
chl          0.05396451 0.02278867  0.05525561 0.02087995

保持正确的mids-object

下面我的替代方法展示了如何合并填充对象并保留mids对象背后的全部功能。自从ibind解决方案之后,我就把这个留给了那些对探索如何合并复杂列表感兴趣的人。
我已经研究了mice的mids对象,为了在并行运行后获得至少一个类似的mids对象,你必须采取一些步骤。如果我们检查mids对象并比较两个具有两种不同设置的对象,我们得到:

library(mice)
imp <- list()
imp <- c(imp,
         list(mice(nhanes, m = 40)))
imp <- c(imp,
         list(mice(nhanes, m = 20)))

sapply(names(imp[[1]]),
       function(n)
         try(all(useful::compare.list(imp[[1]][[n]], 
                                      imp[[2]][[n]]))))


其中可以看到调用m、imp、chainMean和chainVar在两次运行之间不同。其中小鬼无疑是最重要的,但它似乎是一个明智的选择,以更新其他组件以及。因此,我们将从构建一个mice合并函数开始:

mergeMice <- function (imp) {
  merged_imp <- NULL
  for (n in 1:length(imp)){
    if (is.null(merged_imp)){
      merged_imp <- imp[[n]]
    }else{
      counter <- merged_imp$m
      # Update counter
      merged_imp$m <- 
        merged_imp$m + imp[[n]]$m
      # Rename chains
      dimnames(imp[[n]]$chainMean)[[3]] <-
        sprintf("Chain %d", (counter + 1):merged_imp$m)
      dimnames(imp[[n]]$chainVar)[[3]] <-
        sprintf("Chain %d", (counter + 1):merged_imp$m)
      # Merge chains
      merged_imp$chainMean <- 
        abind::abind(merged_imp$chainMean, 
                     imp[[n]]$chainMean)
      merged_imp$chainVar <- 
        abind::abind(merged_imp$chainVar, 
                     imp[[n]]$chainVar)
      for (nn in names(merged_imp$imp)){
        # Non-imputed variables are not in the
        # data.frame format but are null
        if (!is.null(imp[[n]]$imp[[nn]])){
          colnames(imp[[n]]$imp[[nn]]) <- 
            (counter + 1):merged_imp$m
          merged_imp$imp[[nn]] <- 
            cbind(merged_imp$imp[[nn]],
                  imp[[n]]$imp[[nn]])
        }
      }
    }
  }
  # TODO: The function should update the $call parameter
  return(merged_imp)
}


我们现在可以简单地通过以下方式合并上述两个生成的估算:

merged_imp <- mergeMice(imp)
merged_imp_pars <- mergeMice(imp_pars)


现在看来,我们得到了正确的输出:

# Compare the three alternatives
cbind(
  summary(pool(with(data=merged_imp,
                    exp=lm(bmi~age+hyp+chl))))[,c("est", "se")],
 summary(pool(with(data=merged_imp_pars,
                    exp=lm(bmi~age+hyp+chl))))[,c("est", "se")],
 summary(pool(with(data=mice(nhanes, 
                             m = merged_imp$m, 
                             printFlag = FALSE),
                   exp=lm(bmi~age+hyp+chl))))[,c("est", "se")])


提供:

est         se         est        se
(Intercept) 20.16057550 3.74819873 20.31814393 3.7346252
age         -3.67906629 1.19873118 -3.64395716 1.1476377
hyp          1.72637216 2.01171565  1.71063127 1.9936347
chl          0.05590999 0.02350609  0.05476829 0.0213819
                    est         se
(Intercept) 20.14271905 3.60702992
age         -3.78345532 1.21550474
hyp          1.77361005 2.11415290
chl          0.05648672 0.02046868


好了,就这样。玩得开心

cgh8pdjw

cgh8pdjw2#

mice 3.15.0和更高版本具有提供并行处理的新futuremice()函数。它取代了旧的parlmice()方法。

相关问题