expand.grid 和mapply的组合？

Question

我正在尝试提出mapply 的变体（现在称为xapply），它结合了expand.grid 和mapply 的功能（某种程度）。也就是说，对于一个函数FUN 和一个参数列表L1、L2、L3，... 未知长度，它应该产生一个长度列表n1*n2*n3 （其中ni 是列表i 的长度）这是将FUN 应用于列表元素的所有组合的结果。

如果expand.grid 用于生成列表列表而不是数据框，则可能可以使用它，但我记住列表可能是不一定适合数据框的事物列表.

如果正好要扩展三个列表，则此功能可以正常工作，但我对更通用的解决方案感到好奇。 （FLATTEN 未使用，但我可以想象FLATTEN=FALSE 会生成嵌套列表而不是单个列表......）

xapply3 <- function(FUN,L1,L2,L3,FLATTEN=TRUE,MoreArgs=NULL) {
  retlist <- list()
  count <- 1
  for (i in seq_along(L1)) {
    for (j in seq_along(L2)) {
      for (k in seq_along(L3)) {
        retlist[[count]] <- do.call(FUN,c(list(L1[[i]],L2[[j]],L3[[k]]),MoreArgs))
        count <- count+1
      }
    }
  }
  retlist
}

编辑：忘记返回结果。可以通过使用combn 列出索引并从那里开始来解决这个问题...

Answer 1

我想我自己的问题有一个解决方案，但也许有人可以做得更好（而且我还没有实现FLATTEN=FALSE ...）

xapply <- function(FUN,...,FLATTEN=TRUE,MoreArgs=NULL) {
  L <- list(...)
  inds <- do.call(expand.grid,lapply(L,seq_along)) ## Marek's suggestion
  retlist <- list()
  for (i in 1:nrow(inds)) {
    arglist <- mapply(function(x,j) x[[j]],L,as.list(inds[i,]),SIMPLIFY=FALSE)
    if (FLATTEN) {
      retlist[[i]] <- do.call(FUN,c(arglist,MoreArgs))
    }
  }
  retlist
}

编辑：我尝试了@baptiste 的建议，但这并不容易（或者不适合我）。我得到的最接近的是

xapply2 <- function(FUN,...,FLATTEN=TRUE,MoreArgs=NULL) {
  L <- list(...)
  xx <- do.call(expand.grid,L)
  f <- function(...) {
    do.call(FUN,lapply(list(...),"[[",1))
  }
  mlply(xx,f)
}

这仍然不起作用。 expand.grid 确实比我想象的更灵活（尽管它会创建一个无法打印的奇怪数据框），但 mlply 内部正在发生足够的魔力，我无法让它发挥作用。

这是一个测试用例：

L1 <- list(data.frame(x=1:10,y=1:10),
           data.frame(x=runif(10),y=runif(10)),
           data.frame(x=rnorm(10),y=rnorm(10)))

L2 <- list(y~1,y~x,y~poly(x,2))          
z <- xapply(lm,L2,L1)
xapply(lm,L2,L1)

Answer 2

@ben-bolker，我也有类似的愿望，并认为我已经制定了一个初步的解决方案，我还测试过它可以并行工作。这个函数，我有点混淆地称为gmcmapply（g 表示网格）需要一个任意大的命名列表mvars（在函数中得到expand.grid-ed）和一个FUN，它使用列表名称，就好像它们是函数本身的参数（gmcmapply 将更新 FUN 的形式，以便在将 FUN 传递给 mcmapply 时，它的参数反映了用户想要迭代的变量（这将是层在嵌套的 for 循环中））。 mcmapply 然后在循环遍历 mvars 中的扩展变量集时动态更新这些形式的值。

我已将初步代码发布为a gist (reprinted with an example below)，很想得到您的反馈。我是一名研究生，自称是中级 R 爱好者，所以这肯定会推动我的 R 技能。您或社区中的其他人可能会提出可以改进我所拥有的建议。我确实认为，即便如此，我将来也会经常使用这个功能。

gmcmapply <- function(mvars, FUN, SIMPLIFY = FALSE, mc.cores = 1, ...){
  require(parallel)

  FUN <- match.fun(FUN)
  funArgs <- formals(FUN)[which(names(formals(FUN)) != "...")] # allow for default args to carry over from FUN.

  expand.dots <- list(...) # allows for expanded dot args to be passed as formal args to the user specified function

  # Implement non-default arg substitutions passed through dots.
  if(any(names(funArgs) %in% names(expand.dots))){
    dot_overwrite <- names(funArgs[which(names(funArgs) %in% names(expand.dots))])
    funArgs[dot_overwrite] <- expand.dots[dot_overwrite]

    #for arg naming and matching below.
    expand.dots[dot_overwrite] <- NULL
  }

  ## build grid of mvars to loop over, this ensures that each combination of various inputs is evaluated (equivalent to creating a structure of nested for loops)
  grid <- expand.grid(mvars,KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE)

  # specify formals of the function to be evaluated  by merging the grid to mapply over with expanded dot args
  argdefs <- rep(list(bquote()), ncol(grid) + length(expand.dots) + length(funArgs) + 1)
  names(argdefs) <- c(colnames(grid), names(funArgs), names(expand.dots), "...")

  argdefs[which(names(argdefs) %in% names(funArgs))] <- funArgs # replace with proper dot arg inputs.
  argdefs[which(names(argdefs) %in% names(expand.dots))] <- expand.dots # replace with proper dot arg inputs.

  formals(FUN) <- argdefs

  if(SIMPLIFY) {
    #standard mapply
    do.call(mcmapply, c(FUN, c(unname(grid), mc.cores = mc.cores))) # mc.cores = 1 == mapply
  } else{
    #standard Map
    do.call(mcmapply, c(FUN, c(unname(grid), SIMPLIFY = FALSE, mc.cores = mc.cores)))
  }
}

下面的示例代码：

      # Example 1:
      # just make sure variables used in your function appear as the names of mvars
      myfunc <- function(...){
        return_me <- paste(l3, l1^2 + l2, sep = "_")
        return(return_me)
      }

      mvars <- list(l1 = 1:10,
                    l2 = 1:5,
                    l3 = letters[1:3])


      ### list output (mapply)
      lreturns <- gmcmapply(mvars, myfunc)

      ### concatenated output (Map)
      lreturns <- gmcmapply(mvars, myfunc, SIMPLIFY = TRUE)

      ## N.B. This is equivalent to running:
      lreturns <- c()
      for(l1 in 1:10){
        for(l2 in 1:5){
          for(l3 in letters[1:3]){
            lreturns <- c(lreturns,myfunc(l1,l2,l3))
          }
        }
      }

      ### concatenated outout run on 2 cores.
      lreturns <- gmcmapply(mvars, myfunc, SIMPLIFY = TRUE, mc.cores = 2)

     Example 2. Pass non-default args to FUN.
     ## Since the apply functions dont accept full calls as inputs (calls are internal), user can pass arguments to FUN through dots, which can overwrite a default option for FUN.
     # e.g. apply(x,1,FUN) works and apply(x,1,FUN(arg_to_change= not_default)) does not, the correct way to specify non-default/additional args to FUN is:
     # gmcmapply(mvars, FUN, arg_to_change = not_default)

     ## update myfunc to have a default argument
      myfunc <- function(rep_letters = 3, ...){
        return_me <- paste(rep(l3, rep_letters), l1^2 + l2, sep = "_")
        return(return_me)
      }

      lreturns <- gmcmapply(mvars, myfunc, rep_letters = 1)

我想添加但仍在努力解决的一些附加功能是

1. 将输出清理为带有 mvar 名称的漂亮嵌套列表（通常，我会在嵌套的 for 循环中创建多个列表，并将低级列表标记到更高级别的列表，直到所有层巨大的嵌套循环已完成）。我认为使用here 提供的解决方案的一些抽象变体会起作用，但我还没有想出如何使解决方案灵活适应expand.grid-ed data.frame 中的列数。

2. 我想要一个选项来记录在用户指定目录中mcmapply 中调用的子进程的输出。因此，您可以查看expand.grid 生成的每个变量组合的 .txt 输出（即，如果用户像我经常做的那样将模型摘要或状态消息作为FUN 的一部分打印）。我认为一个可行的解决方案是使用substitute() 和body() 函数，描述here 编辑FUN 在FUN 的开头打开一个sink()，如果用户指定在最后关闭它要写入的目录。现在，我只是将它直接编程到FUN 本身，但稍后最好只传递gmcmapply 一个名为log_children = "path_to_log_dir 的参数。然后将函数体编辑为（伪代码）sink(file = file.path(log_children, paste0(paste(names(mvars), sep = "_"), ".txt")

让我知道你的想法！

-内特