说我有两个矩阵:
> 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
中的行数相同。我正在寻找一种矢量化方法,以逐行方式从a
中的列号中指示的b
中提取项目。因此,结果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如何用于提取矩阵元素。
答案 0 :(得分:3)
你可以尝试
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
答案 1 :(得分:3)
这是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