Mnożenie Kombinacje listy w R

Question

Biorąc pod uwagę listę dwóch list, próbuję uzyskać, bez użycia dla pętli, listę wszystkich produktów elementowych z pierwszej listy z drugą. Na przykład:

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

Funkcja powinna zwrócić listę z 9 wpisami, każdy o rozmiarze drugim. Na przykład:

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

[[2]] 
[1] 3 8 

[[3]] 
[1] 6 4 

[[4]] 
[1] 2 9 

[[5]] 
[1] 6 12 

etc... 

Wszelkie sugestie będą mile widziane!

Answer 1

mam pojęcia, czy to szybko albo intensywnie wykorzystujących pamięć tylko, że to działa, odpowiedź Joris Meys jest bardziej wymowny:

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: Teraz, Brian wprowadził benchmarkingu (które kocham (LINK)) Muszę odpowiedzieć. Właściwie mam szybszą odpowiedź przy użyciu tego, co nazywam expand.grid2, czyli lżejszej wersji oryginału, którą ukradłem z HERE. Miałem zamiar rzucić to wcześniej, ale kiedy zobaczyłem, jak szybko jest Joris, pomyślałem, po co zawracać sobie głowę, zarówno krótkie, jak i słodkie, ale też szybkie. Ale teraz, kiedy Diggs wykopał, pomyślałem, że zwymiotuję tutaj do celów edukacyjnych.

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) 

Oto wyniki (sama etykiecie jako Bryan, z wyjątkiem TylerEG2 używa 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 

A jeśli wezmę kolejność wyjść mogę piszczą się jeszcze bardziej, ale to nadal nie jest blisko odpowiedzi Jorisa.

Answer 2

Szybkim (ale pamięć intensywnie) sposobem byłoby wykorzystanie mechanizmu mapply w połączeniu z recyklingu argument coś takiego:

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

daje:

> 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 

Albo zastąpić a z c[[1]] i b z c[[2]], aby uzyskać to samo. Aby uzyskać listę, ustaw argument 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

Ciągnięcie pomysły od innych odpowiedzi razem, dorzucę kolejną jedną wkładkę w dla zabawy:

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

co daje

 [,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 

Jeśli naprawdę potrzebujesz go w formacie, który podałeś, następnie możesz użyć biblioteki plyr do tran sform go na to:

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

co daje

[[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 

---

Tylko dla zabawy, benchmarking:

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

i benchmarki

> 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 

i pokazują, że są one równoważne:

> 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