expand.grid和mapply的组合?

时间:2011-06-29 02:25:39

标签: r lapply

我正在尝试提出mapply的变种(现在称之为xapply),它结合了expand.gridmapply的功能(种类)。也就是说,对于函数FUN和参数列表L1L2L3,... 未知长度,它应该是生成一个长度为n1*n2*n3的列表(其中ni是列表i的长度),这是将FUN应用于列表元素的所有组合的结果。< / p>

如果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制作一个索引列表并从那里开始......

来解决这个问题

2 个答案:

答案 0 :(得分:2)

我认为我对自己的问题有解决方案,但也许有人可以做得更好(我没有实施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内部发生了足够的魔法,我无法使其发挥作用。< / p>

这是一个测试用例:

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)

答案 1 :(得分:1)

@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 中的列数。< /p>

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

告诉我你的想法!

-内特