Multiplicando Combinaciones de una lista de listas en R

Question

Dando una lista de dos listas, estoy tratando de obtener, sin usar for bucles, una lista de todos los productos de elemento de la primera lista con la segunda. Por ejemplo:

> a <- list(c(1,2), c(2,3), c(4,5)) 
> b <- list(c(1,3), c(3,4), c(6,2)) 
> c <- list(a, b) 

La función debe devolver una lista con 9 entradas, cada una de dos. Por ejemplo,

> answer 
[[1]] 
[1] 1 6 

[[2]] 
[1] 3 8 

[[3]] 
[1] 6 4 

[[4]] 
[1] 2 9 

[[5]] 
[1] 6 12 

etc... 

¡Cualquier sugerencia sería muy apreciada!

Answer 1

tengo ni idea de si esto es rápido o mucha memoria sólo que funciona, la respuesta de Joris Meys es más elocuente:

x <- expand.grid(1:length(a), 1:length(b)) 
x <- x[order(x$Var1), ] #gives the order you asked for 
FUN <- function(i) diag(outer(a[[x[i, 1]]], b[[x[i, 2]]], "*")) 
sapply(1:nrow(x), FUN)  #I like this out put 
lapply(1:nrow(x), FUN)  #This one matches what you asked for 

EDIT: Ahora que Brian introdujo la evaluación comparativa (que me encanta (LINK)) Tengo que responder. De hecho, tengo una respuesta más rápida usando lo que llamo expand.grid2 que es una versión más liviana del original que robé desde HERE. Iba a tirarlo antes, pero cuando vi lo rápido que es Joris, pensé por qué molestarme, tanto corto como dulce pero también rápido. Pero ahora que Diggs ha excavado, pensé que arrojaría aquí el expand.grid2 con fines educativos.

expand.grid2 <-function(seq1,seq2) { 
    cbind(Var1 = rep.int(seq1, length(seq2)), 
    Var2 = rep.int(seq2, rep.int(length(seq1),length(seq2)))) 
} 

x <- expand.grid2(1:length(a), 1:length(b)) 
x <- x[order(x[,'Var1']), ] #gives the order you asked for 
FUN <- function(i) diag(outer(a[[x[i, 1]]], b[[x[i, 2]]], "*")) 
lapply(1:nrow(x), FUN) 

aquí está el resultado (el mismo etiquetado como Bryan excepto TylerEG2 está utilizando el expand.grid2):

Unit: microseconds 
      expr  min  lq median  uq  max 
1 DiggsL(a, b) 5102.296 5307.816 5471.578 5887.516 70965.58 
2 DiggsM(a, b) 384.912 428.769 443.466 461.428 36213.89 
3 Joris(a, b) 91.446 105.210 123.172 130.171 16833.47 
4 TylerEG2(a, b) 392.377 425.503 438.100 453.263 32208.94 
5 TylerL(a, b) 1752.398 1808.852 1847.577 1975.880 49214.10 
6 TylerM(a, b) 1827.515 1888.867 1925.959 2090.421 75766.01 
7 Wojciech(a, b) 1719.740 1771.760 1807.686 1924.325 81666.12 

Y si tomo el pedido salir puedo rechinan aún más, pero todavía no es cerca de la respuesta de Joris.

Answer 2

Una manera rápida (pero mucha memoria) sería utilizar el mecanismo de mapply en combinación con el reciclaje argumento, algo como esto:

mapply(`*`,a,rep(b,each=length(a))) 

Da:

> mapply(`*`,a,rep(b,each=length(a))) 
    [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] 
[1,] 1 2 4 3 6 12 6 12 24 
[2,] 6 9 15 8 12 20 4 6 10 

O reemplazar a con c[[1]] y b con c[[2]] para obtener el mismo. Para obtener una lista, establezca el argumento SIMPLIFY = FALSE.

Answer 3

# Your data 
a <- list(c(1,2), c(2,3), c(4,5)) 
b <- list(c(1,3), c(3,4), c(6,2)) 

# Matrix with indicies for elements to multiply 
G <- expand.grid(1:3,1:3) 

# Coversion of G to list 
L <- lapply(1:nrow(G),function(x,d=G) d[x,]) 

lapply(L,function(i,x=a,y=b) x[[i[[2]]]]*y[[i[[1]]]]) 

Answer 4

Tirando ideas de las otras respuestas juntos, voy a tirar otra de una sola línea para la diversión en:

do.call(mapply, c(FUN=`*`, as.list(expand.grid(b, a)))) 

lo que da

 [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] 
[1,] 1 3 6 2 6 12 4 12 24 
[2,] 6 8 4 9 12 6 15 20 10 

Si realmente lo necesito en el formato que usted dio, entonces puede usar la biblioteca plyr para tran sform en que:

library("plyr") 
as.list(unname(alply(do.call(mapply, c(FUN=`*`, as.list(expand.grid(b, a)))), 2))) 

lo que da

[[1]] 
[1] 1 6 

[[2]] 
[1] 3 8 

[[3]] 
[1] 6 4 

[[4]] 
[1] 2 9 

[[5]] 
[1] 6 12 

[[6]] 
[1] 12 6 

[[7]] 
[1] 4 15 

[[8]] 
[1] 12 20 

[[9]] 
[1] 24 10 

---

Sólo por diversión, la evaluación comparativa:

Joris <- function(a, b) { 
    mapply(`*`,a,rep(b,each=length(a))) 
} 

TylerM <- function(a, b) { 
    x <- expand.grid(1:length(a), 1:length(b)) 
    x <- x[order(x$Var1), ] #gives the order you asked for 
    FUN <- function(i) diag(outer(a[[x[i, 1]]], b[[x[i, 2]]], "*")) 
    sapply(1:nrow(x), FUN) 
} 

TylerL <- function(a, b) { 
    x <- expand.grid(1:length(a), 1:length(b)) 
    x <- x[order(x$Var1), ] #gives the order you asked for 
    FUN <- function(i) diag(outer(a[[x[i, 1]]], b[[x[i, 2]]], "*")) 
    lapply(1:nrow(x), FUN) 
} 

Wojciech <- function(a, b) { 
    # Matrix with indicies for elements to multiply 
    G <- expand.grid(1:3,1:3) 

    # Coversion of G to list 
    L <- lapply(1:nrow(G),function(x,d=G) d[x,]) 

    lapply(L,function(i,x=a,y=b) x[[i[[2]]]]*y[[i[[1]]]]) 
} 

DiggsM <- function(a, b) { 
    do.call(mapply, c(FUN=`*`, as.list(expand.grid(b, a)))) 
} 

DiggsL <- function(a, b) { 
    as.list(unname(alply(t(do.call(mapply, c(FUN=`*`, as.list(expand.grid(b, a))))), 1))) 
} 

y los puntos de referencia

> library("rbenchmark") 
> benchmark(Joris(b,a), 
+   TylerM(a,b), 
+   TylerL(a,b), 
+   Wojciech(a,b), 
+   DiggsM(a,b), 
+   DiggsL(a,b), 
+   order = "relative", 
+   replications = 1000, 
+   columns = c("test", "elapsed", "relative")) 
      test elapsed relative 
1 Joris(b, a) 0.08 1.000 
5 DiggsM(a, b) 0.26 3.250 
4 Wojciech(a, b) 1.34 16.750 
3 TylerL(a, b) 1.36 17.000 
2 TylerM(a, b) 1.40 17.500 
6 DiggsL(a, b) 3.49 43.625 

y para mostrar que son equivalentes:

> identical(Joris(b,a), TylerM(a,b)) 
[1] TRUE 
> identical(Joris(b,a), DiggsM(a,b)) 
[1] TRUE 
> identical(TylerL(a,b), Wojciech(a,b)) 
[1] TRUE 
> identical(TylerL(a,b), DiggsL(a,b)) 
[1] TRUE