2014-09-18 4 views
17

Mi piacerebbe essere in grado di applicare una funzione a tutte le combinazioni di un insieme di argomenti di input. Ho una soluzione funzionante (sotto), ma sarei sorpreso se non ci fosse un modo migliore/più generico per farlo usando, ad es. plyr, ma finora non hanno trovato nulla. C'è una soluzione migliore?Applicare una funzione su tutte le combinazioni di argomenti

# Apply function FUN to all combinations of arguments and append results to 
# data frame of arguments 
cmapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, 
    USE.NAMES = TRUE) 
{ 
    l <- expand.grid(..., stringsAsFactors=FALSE) 
    r <- do.call(mapply, c(
     list(FUN=FUN, MoreArgs = MoreArgs, SIMPLIFY = SIMPLIFY, USE.NAMES = USE.NAMES), 
     l 
    )) 
    if (is.matrix(r)) r <- t(r) 
    cbind(l, r) 
} 

esempi:

# calculate sum of combinations of 1:3, 1:3 and 1:2 
cmapply(arg1=1:3, arg2=1:3, 1:2, FUN=sum) 

# paste input arguments 
cmapply(arg1=1:3, arg2=c("a", "b"), c("x", "y", "z"), FUN=paste) 

# function returns a vector 
cmapply(a=1:3, b=2, FUN=function(a, b) c("x"=b-a, "y"=a+b)) 
+5

Che cosa si intende per "migliore"? Quello che hai sembra essere eccellente. – Roland

+0

Speravo solo che ci fosse già una funzione esistente da qualche parte là fuori – wannymahoots

+0

Non che io sappia. Puoi passare una funzione a 'combn' o' outer', ma non è proprio quello che vuoi. – Roland

risposta

1

Questa funzione non è necessariamente meglio, solo un po 'diverso:

rcapply <- function(FUN, ...) { 

    ## Cross-join all vectors 
    DT <- CJ(...) 

    ## Get the original names 
    nl <- names(list(...)) 

    ## Make names, if all are missing 
    if(length(nl)==0L) nl <- make.names(1:length(list(...))) 

    ## Fill in any missing names 
    nl[!nzchar(nl)] <- paste0("arg", 1:length(nl))[!nzchar(nl)] 
    setnames(DT, nl) 

    ## Call the function using all columns of every row 
    DT2 <- DT[, 
      as.data.table(as.list(do.call(FUN, .SD))), ## Use all columns... 
      by=.(rn=1:nrow(DT))][ ## ...by every row 
       , rn:=NULL] ## Remove the temp row number 

    ## Add res to names of unnamed result columns 
    setnames(DT2, gsub("(V)([0-9]+)", "res\\2", names(DT2))) 

    return(data.table(DT, DT2)) 
} 

head(rcapply(arg1=1:3, arg2=1:3, 1:2, FUN=sum)) 
## arg1 arg2 arg3 res1 
## 1: 1 1 1 3 
## 2: 1 1 2 4 
## 3: 1 2 1 4 
## 4: 1 2 2 5 
## 5: 1 3 1 5 
## 6: 1 3 2 6 

head(rcapply(arg1=1:3, arg2=c("a", "b"), c("x", "y", "z"), FUN=paste)) 
## arg1 arg2 arg3 res1 
## 1: 1 a x 1 a x 
## 2: 1 a y 1 a y 
## 3: 1 a z 1 a z 
## 4: 1 b x 1 b x 
## 5: 1 b y 1 b y 
## 6: 1 b z 1 b z 

head(rcapply(a=1:3, b=2, FUN=function(a, b) c("x"=b-a, "y"=a+b))) 
## a b x y 
## 1: 1 2 1 3 
## 2: 2 2 0 4 
## 3: 3 2 -1 5