Сочетание расширения .grid и mapply? - PullRequest
Новая
       3

Сочетание расширения .grid и mapply?

8 голосов
/ 29 июня 2011

Я пытаюсь найти вариант 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
}

edit: забыл вернуть результат,Можно решить эту проблему, составив список индексов с combn и перейдя оттуда ...

1 Ответ

2 голосов
/ 29 июня 2011

Я думаю, что у меня есть решение моего собственного вопроса, но, возможно, кто-то может сделать лучше (а я не реализовал 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 Я попробовал предложение @ 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)
...