使用列行索引从矩阵中提取值答案

【问题标题】：Extract values from matrix using col row indices使用列行索引从矩阵中提取值
【发布时间】：2015-02-20 03:54:37
【问题描述】：

假设我有两个矩阵：

> a
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    6   10    5    7    2    2    6
[2,]   10    6    7    7    4    3   12
[3,]   11   10    2   10    6   11    9

和

> b
         [,1] [,2] [,3]
    [1,]    4    1    4
    [2,]    3    6    3
    [3,]    2    5    2

a 和 b 中的行数相同。我正在寻找一种向量化的方法来逐行从b 中的列号指示的a 中提取项目。因此，结果c 应如下所示：

> c
     [,1] [,2] [,3]
[1,]    7    6    7
[2,]    7    3    7
[3,]    10    6   10

a[,b[1,]] 或 a[,b[2,]] 或 a[,b[3,]] 设法分别获得第 1、2 和 3 行的正确结果。这完全可以用一个简单的矩阵函数来完成吗？ apply有必要吗？

我曾尝试在Index values from a matrix using row, col indicies 中调整类似问题的解决方案，但不明白此处如何使用 cbind 来提取矩阵元素。

【问题讨论】：

标签： r matrix indexing

【解决方案1】：

你可以试试

t(sapply(seq_len(nrow(a)), function(i) a[i, b[i, ]]))
#      [,1] [,2] [,3]
# [1,]    7    6    7
# [2,]    7    3    7
# [3,]   10    6   10

您可能会看到上面的sapply 解决方案与vapply 相比，速度略有提高

s <- seq_len(nrow(a))
t(vapply(s, function(i) a[i, b[i, ]], numeric(ncol(b))))
#      [,1] [,2] [,3]
# [1,]    7    6    7
# [2,]    7    3    7
# [3,]   10    6   10

或者for循环解决方案是

m <- matrix(, nrow(b), ncol(b))
for(i in seq_len(nrow(a))) { m[i, ] <- a[i, b[i, ]] }
m
#      [,1] [,2] [,3]
# [1,]    7    6    7
# [2,]    7    3    7
# [3,]   10    6   10

【讨论】：

@David - 太好了。我担心它会很慢，所以我正在研究更好的东西
它在我的机器上对一个 200kb 的整数数据对象在大约 1 秒内完成了这项工作。速度非常适合我的应用程序。再次感谢。

【解决方案2】：

这里是cbind 版本

 t(`dim<-`(a[cbind(rep(1:nrow(a), each=ncol(b)), c(t(b)))], dim(b)))
 #     [,1] [,2] [,3]
 #[1,]    7    6    7
 #[2,]    7    3    7
 #[3,]   10    6   10

或者按照@thelatemail的建议

 matrix(a[cbind(c(row(b)),c(b))],nrow=nrow(a))
 #     [,1] [,2] [,3]
 #[1,]    7    6    7
 #[2,]    7    3    7
 #[3,]   10    6   10

基准测试

set.seed(24)
a1 <- matrix(sample(1:10, 2e5*7, replace=TRUE), ncol=7)
set.seed(28)
b1 <- matrix(sample(1:7,2e5*3, replace=TRUE), ncol=3)

f1 <- function() {s <- seq_len(nrow(a1))
 t(vapply(s, function(i) a1[i, b1[i,]],numeric(ncol(b1))))
}
f2 <- function() {matrix(a1[cbind(c(row(b1)),c(b1))], nrow=nrow(a1)) }
f3 <- function(){t(`dim<-`(a1[cbind(rep(1:nrow(a1),
                    each=ncol(b1)), c(t(b1)))], dim(b1)))} 
library(microbenchmark)
microbenchmark(f1(), f2(), f3(), unit='relative', times=10L)
#Unit: relative
# expr       min        lq      mean    median        uq       max neval cld
#f1() 16.636045 16.603856 15.319595 15.799335 13.869147 14.629315    10   b
#f2()  1.000000  1.000000  1.000000  1.000000  1.000000  1.000000    10  a 
#f3()  1.310433  1.306228  1.258715  1.278504  1.237299  1.236448    10  a

【讨论】：