combination of expand.grid and mapply?

我与影子孤独终老i 提交于 2019-11-29 10:06:18

I think I have a solution to my own question, but perhaps someone can do better (and I haven't implemented 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
}

edit: I tried @baptiste's suggestion, but it's not easy (or wasn't for me). The closest I got was

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

which still doesn't work. expand.grid is indeed more flexible than I thought (although it creates a weird data frame that can't be printed), but enough magic is happening inside mlply that I can't quite make it work.

Here is a test case:

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)
标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!