將列表中的列表乘以R的組合

Question

給定兩個列表的列表，我試圖在不使用for循環的情況下獲取第一個列表中所有基於元素的產品列表。例如：

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

函數應該返回一個包含9個條目的列表，每個條目的大小爲2。例如，

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

[[2]] 
[1] 3 8 

[[3]] 
[1] 6 4 

[[4]] 
[1] 2 9 

[[5]] 
[1] 6 12 

etc... 

任何建議將不勝感激！

Answer 1

不知道這是否是快還是內存密集型的只是它的工作原理，里斯Meys的回答是更雄辯：

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 

編輯：現在，布萊恩介紹了基準（這是我的愛（LINK））我必須迴應。實際上，我使用我稱之爲expand.grid2的更快的答案，這是我從HERE偷來的原始文本的較輕重量版本。我以前會把它扔掉，但是當我看到Joris的速度有多快時，我想到了爲什麼要麻煩，既快又甜又快。但是現在Digg已經挖了我想我會扔在這裏爲教育目的expand.grid2。

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) 

這裏的結果（相同標籤的布賴恩除了TylerEG2使用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 

如果我把訂貨走出我吱了，甚至更多，但它仍然是不接近喬里斯的回答。

Answer 2

快速（但內存密集型）的方法是使用mapply機制結合參數回收，這樣的事情：

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

給出：

> 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 

或更換a與c[[1]]和b與c[[2]]獲得相同。要獲取列表，請設置參數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

甩開了其他答案的想法一起，我會扔一個又一個班輪在樂趣：

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

這給

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

如果您真的需要它在你給的格式，那麼你可以使用plyr庫tran sform它變成：

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

這給

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

---

只是爲了好玩，標杆：

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

和基準

> 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 

並顯示它們是等效的：

> 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