在 dplyr::do 中使用 multidplyr 调用带有参数的函数答案

【问题标题】：Calling a function with arguments within dplyr::do using multidplyr在 dplyr::do 中使用 multidplyr 调用带有参数的函数
【发布时间】：2018-04-21 15:01:42
【问题描述】：

我正在尝试使用 multidplyr 来加快从 regression 匹配中获取 residuals 的速度。我创建了一个适合regression 模型的function 来获取residuals，除了数据之外，它还有两个参数。

这是function：

func <- function(df,reg.mdl,mdl.fmla)
{
  if(reg.mdl == "linear"){
    df$resid <- lm(formula = mdl.fmla, data = df)$residuals
  } else if(reg.mdl == "poisson"){
    df$resid <- residuals(object = glm(formula = mdl.fmla,data = df,family = "poisson"),type='pearson')
  }
  return(df)
}

这是我将尝试使用multidplyr 方法的示例数据：

set.seed(1)
ds <- data.frame(group=c(rep("a",100), rep("b",100),rep("c",100)),sex=rep(sample(c("F","M"),100,replace=T),3),y=rpois(300,10))
model.formula <- as.formula("y ~ sex")
regression.model <- "poisson"

这是multidplyr 方法：

ds %>% partition(group) %>% cluster_library("tidyverse") %>%
  cluster_assign_value("func", func) %>%
  do(results = func(df=.,reg.mdl=regression.model,mdl.fmla=model.formula)) %>% collect() %>% .$results %>% bind_rows()

这会引发此错误：

Error in checkForRemoteErrors(lapply(cl, recvResult)) : 
  3 nodes produced errors; first error: object 'regression.model' not found
In addition: Warning message:
group_indices_.grouped_df ignores extra arguments

所以我猜我将参数从do 传递给func 的方式是错误的。

知道正确的方法是什么吗？

【问题讨论】：

标签： r arguments dplyr multidplyr

【解决方案1】：

由于集群在其环境中没有此类对象而导致的错误。因此需要将变量分配给集群进程：

ds %>%
  partition(group) %>%
  cluster_library("tidyverse") %>%
  cluster_assign_value("func", func) %>%
  cluster_copy(regression.model) %>%
  cluster_copy(model.formula) %>%
  do(results = func(
    df = .,
    reg.mdl = regression.model,
    mdl.fmla = model.formula
  )) %>%
  collect() %>%
  .$results %>%
  bind_rows()

或者另一种方式（我更喜欢在链之前设置集群）：

CL <- makePSOCKcluster(3)
clusterEvalQ(cl = CL, library("tidyverse"))
clusterExport(cl = CL, list("func", "regression.model", "model.formula"))

ds %>%
  partition(group, cluster = CL) %>%
  do(results = func(
    df = .,
    reg.mdl = regression.model,
    mdl.fmla = model.formula
  )) %>%
  collect() %>%
  .$results %>%
  bind_rows()

stopCluster(CL)

【讨论】：