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创建索引列表并从那里开始解决这个问题...

- Ben Bolker

---

我可能漏掉了什么，但是使用plyr::m*ply（以及expand.grid）似乎是一个简单的任务。 - baptiste

好的。我认为数据框和expand.grid可能比我想象的更灵活... - Ben Bolker

请参考这里的相关函数：https://dev59.com/MFfUa4cB1Zd3GeqPLMUF，它是基于outer函数实现的。 - Aaron left Stack Overflow

嗯。有人给个踩的理由吗？ - Ben Bolker

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)

- Ben Bolker

---

简写：inds <- do.call(expand.grid, lapply(L, seq_along)) - Marek

@ben-bolker，第二个示例无法正常工作，因为expand.grid生成一个数据框。 由于您的测试向xapply2提供了未命名的参数，因此expand.grid使用默认列名称。 但是，这意味着第二个do.call也将使用默认名称作为要测试的函数（lm）的命名参数。执行xapply2(lm,data=L1,formula=L2)应该没有问题。（抱歉-我知道这很古老，但它在我脑海中挥之不去 :)） - machow

Answer 2

@ben-bolker，我有类似的愿望，并且我已经想出了一个初步的解决方案，我也测试了并行工作。这个函数有些令人困惑地被称为gmcmapply（g代表网格），它接受任意大小的命名列表mvars（在函数内部进行了expand.grid），以及一个FUN，该函数使用列表名称，就好像它们是函数本身的参数一样（gmcmapply将更新FUN的形式，以便在将FUN传递给mcmapply时，其参数反映用户希望迭代的变量（这将是嵌套for循环中的层））。然后，mcmapply在循环遍历mvars中扩展的变量集时动态更新这些形式的值。

我已经发布了初步代码，链接为一个 gist（下面有一个示例），很想听听你的反馈。我是一名研究生，自认为是中级水平的 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. 清理输出，使其成为一个漂亮的嵌套列表，并显示mvars的名称(通常情况下，我会在嵌套循环中创建多个列表，并将低级别的列表标记到较高级别的列表，直到完成巨大的嵌套循环的所有层级)。我认为使用提供的解决方案的某些抽象变体here将起作用，但我还没有想出如何使解决方案灵活地适应expand.grid数据框中的列数。

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

让我知道你的想法！

- Nate

- Nate Hall