Question

我有两个矩阵，称它们为A（n x 2）和B（q x 2）。我想获得一个nxqx 2数组C，这样C [1,5，]表示第一行A和第五行B之间的差值，减去第一行中的第一个元素A与第五行B中的第一个元素和第二个元素相似地减去。

我试图通过outer功能执行此功能，但它也给了我＆＃34;非对角线＆＃34;减法;即它也会减去我不感兴趣的A [1,1] - B [5,2]和A [1,2] - B [5,1]。有没有人有一个快速，简单的方法来做到这一点？

当前代码

>diffs <- outer(A,B,FUN ='-')
>diffs[1,,5,]
           [,1]      [,2]
[1,] **-0.3808701** 0.7591052
[2,]  0.2629293 **1.4029046**

我添加了星星以表明我真正想要的东西。

感谢您提前提供任何帮助

（编辑）这是一个用于说明目的的更简单的案例

> A <- matrix(1:10, nrow = 5, ncol = 2)
> B <- matrix(4:9, nrow = 3, ncol = 2)
> A
         [,1] [,2]
[1,]    1    6
[2,]    2    7
[3,]    3    8
[4,]    4    9
[5,]    5   10
> B
    [,1] [,2]
[1,]    4    7
[2,]    5    8
[3,]    6    9

>diffs <- outer(A,B,FUN ='-')
>diffs[1,,3,] == (A[1,] - B[3,])
        [,1]  [,2]
[1,]  TRUE FALSE
[2,] FALSE  TRUE

>diffs[1,,3,]
     [,1] [,2]
[1,]   -5   -8
[2,]    0   -3

Answer 1

在担心输出的形状之前，我认为我们应该确保获得正确的值。

A <- matrix(1:10, nrow=5, ncol=2)
B <- matrix(4:9, nrow=3, ncol=2)

# long-winded method
dia_long <- c(
c(A[1,] - B[1,]),
c(A[1,] - B[2,]),
c(A[1,] - B[3,]),
c(A[2,] - B[1,]),
c(A[2,] - B[2,]),
c(A[2,] - B[3,]),
c(A[3,] - B[1,]),
c(A[3,] - B[2,]),
c(A[3,] - B[3,]),
c(A[4,] - B[1,]),
c(A[4,] - B[2,]),
c(A[4,] - B[3,]),
c(A[5,] - B[1,]),
c(A[5,] - B[2,]),
c(A[5,] - B[3,]))

# loop method
comb <- expand.grid(1:nrow(A), 1:nrow(B))
dia_loop <- list()

for (i in 1:nrow(comb)) {
    dia_loop[[i]] <- A[comb[i, 1], ] - B[comb[i, 2], ]
}
dia_loop <- unlist(dia_loop)

# outer/apply method
dia_outer <- apply(outer(A, B, FUN='-'), c(3, 1), diag)

# they all return the same values
all.identical <- function(l) {
    all(sapply(2:length(l), FUN=function(x) identical(l[1], l[x])))
}

all.identical(lapply(list(dia_long, dia_loop, dia_outer), sort))
# TRUE

table(dia_long)
# dia_long
# -5 -4 -3 -2 -1  0  1  2  3 
#  1  2  4  5  6  5  4  2  1

这些是你要找的值吗？

Answer 2

我的解决方案：使用嵌套lapply和sapply函数来提取对角线。然后，我需要做一些后处理（与此特定问题无关），然后我将其转换为数组。应该注意的是，这是一个q x 2 x n数组，结果证明这对我的目的更好 - 这可以用aperm从这里进行置换，但是要解决原始问题。

A <- matrix(1:10, nrow = 5, ncol = 2)
B <- matrix(4:9, nrow = 3, ncol = 2)

diffs <- outer(A,B, FUN = '-')
diffs <- lapply(X = 1:nrow(A),FUN = function(y){
    t(sapply(1:ncol(B), FUN = function(x) diag(diffs[y,,x,])))})


diffs <- array(unlist(lapply(diffs, FUN = t)), dim = c(nrow(B),2,nrow(A)))

外函数R - 维持坐标减法

2 个答案: