logo标签列表

在R中查找矩阵的相邻元素

rmatrixadjacency-matrix
11

编辑：非常感谢下面的用户做出的巨大贡献，以及Gregor进行基准测试。

假设我有一个填充了整数值的矩阵，像这样...

    mat <- matrix(1:100, 10, 10)

我可以像这样创建每个元素的x，y坐标列表...

    addresses <- expand.grid(x = 1:10, y = 1:10)

现在，针对每个坐标（即mat中的每个元素），我想找到相邻的元素（包括对角线，这应该会有8个相邻元素）。

我相信有一种简单的方法，有人能帮忙吗？

到目前为止，我尝试了循环，并记录如下方式的相邻元素：

    neighbours <- list()
    for(i in 1:dim(addresses)[1]){
      x <- addresses$x[i]
      y <- addresses$y[i]
      neighbours[[i]] <- c(mat[y-1, x  ],
                           mat[y-1, x+1],
                           mat[y  , x+1],
                           mat[y+1, x+1],
                           mat[y+1, x  ],
                           mat[y+1, x-1],
                           mat[y  , x-1],
                           mat[y-1, x-1])
    }

当遇到矩阵边缘时，尤其是索引大于矩阵边缘时，此方法会遇到问题。

2
你想在边缘处做什么？你可以选择“包裹”并将左边缘视为右边缘相邻，或者你可以返回NA，或者可能是其他一些操作。 - Gregor Thomas
2
如果答案是NA，你可以在矩阵中填充NA（使其成为12x12，第一行和最后一行以及第一列和最后一列都是NA），这样你就可以只查看“中间”的所有邻居，从而避免在代码中进行大量的特殊处理。 - Gregor Thomas
目前我只想返回NA。 - roman
谢谢 Gregor，我会选择填充选项。 - roman
非常好，感谢mrip和Gregor，两位都非常有用。 - roman
6个回答
13

这里有一个不错的例子。我做了 4x4 的示例，方便查看，但是可以通过 n 进行调整。它也是完全矢量化的，速度应该很快。

n = 4
mat = matrix(1:n^2, nrow = n)
mat.pad = rbind(NA, cbind(NA, mat, NA), NA)

通过填充矩阵，邻居就是大小为n乘n的子矩阵，可以在周围移动。使用罗盘方向作为标签：

ind = 2:(n + 1) # row/column indices of the "middle"
neigh = rbind(N  = as.vector(mat.pad[ind - 1, ind    ]),
              NE = as.vector(mat.pad[ind - 1, ind + 1]),
              E  = as.vector(mat.pad[ind    , ind + 1]),
              SE = as.vector(mat.pad[ind + 1, ind + 1]),
              S  = as.vector(mat.pad[ind + 1, ind    ]),
              SW = as.vector(mat.pad[ind + 1, ind - 1]),
              W  = as.vector(mat.pad[ind    , ind - 1]),
              NW = as.vector(mat.pad[ind - 1, ind - 1]))

mat
#      [,1] [,2] [,3] [,4]
# [1,]    1    5    9   13
# [2,]    2    6   10   14
# [3,]    3    7   11   15
# [4,]    4    8   12   16

  neigh[, 1:6]
#    [,1] [,2] [,3] [,4] [,5] [,6]
# N    NA    1    2    3   NA    5
# NE   NA    5    6    7   NA    9
# E     5    6    7    8    9   10
# SE    6    7    8   NA   10   11
# S     2    3    4   NA    6    7
# SW   NA   NA   NA   NA    2    3
# W    NA   NA   NA   NA    1    2
# NW   NA   NA   NA   NA   NA    1

因此，您可以看到第一个元素mat [1,1]，从北部开始顺时针移动，邻居是neigh的第一列。下一个元素是mat [2,1]，以此类推沿着mat的列向下移动。(您还可以与@mrip的答案进行比较，看到我们的列具有相同的元素，只是顺序不同。)

基准测试

小矩阵

mat = matrix(1:16, nrow = 4)
mbm(gregor(mat), mrip(mat), marat(mat), u20650(mat), times = 100)
# Unit: microseconds
#         expr     min       lq      mean   median       uq      max neval  cld
#  gregor(mat)  25.054  30.0345  34.04585  31.9960  34.7130   61.879   100 a   
#    mrip(mat) 420.167 443.7120 482.44136 466.1995 483.4045 1820.121   100   c 
#   marat(mat) 746.462 784.0410 812.10347 808.1880 832.4870  911.570   100    d
#  u20650(mat) 186.843 206.4620 220.07242 217.3285 230.7605  269.850   100  b

在一个较大的矩阵中，我不得不删除user20650的函数，因为它尝试分配一个232.8 Gb的向量，并且在等待约10分钟后，我也删除了Marat的答案。

mat = matrix(1:500^2, nrow = 500)

mbm(gregor(mat), mrip(mat), times = 100)
# Unit: milliseconds
#         expr       min        lq      mean    median        uq      max neval cld
#  gregor(mat) 19.583951 21.127883 30.674130 21.656866 22.433661 127.2279   100   b
#    mrip(mat)  2.213725  2.368421  8.957648  2.758102  2.958677 104.9983   100  a

所以，无论何时时间都很重要，@mrip的解决方案都是最快的。

使用的函数：

gregor = function(mat) {
    n = nrow(mat)
    mat.pad = rbind(NA, cbind(NA, mat, NA), NA)
    ind = 2:(n + 1) # row/column indices of the "middle"
    neigh = rbind(N  = as.vector(mat.pad[ind - 1, ind    ]),
                  NE = as.vector(mat.pad[ind - 1, ind + 1]),
                  E  = as.vector(mat.pad[ind    , ind + 1]),
                  SE = as.vector(mat.pad[ind + 1, ind + 1]),
                  S  = as.vector(mat.pad[ind + 1, ind    ]),
                  SW = as.vector(mat.pad[ind + 1, ind - 1]),
                  W  = as.vector(mat.pad[ind    , ind - 1]),
                  NW = as.vector(mat.pad[ind - 1, ind - 1]))
    return(neigh)
}

mrip = function(mat) {
    m2<-cbind(NA,rbind(NA,mat,NA),NA)
    addresses <- expand.grid(x = 1:4, y = 1:4)
    ret <- c()
    for(i in 1:-1)
        for(j in 1:-1)
            if(i!=0 || j !=0)
                ret <- rbind(ret,m2[addresses$x+i+1+nrow(m2)*(addresses$y+j)]) 
    return(ret)
}

get.neighbors <- function(rw, z, mat) {
    # Convert to absolute addresses 
    z2 <- t(z + unlist(rw))
    # Choose those with indices within mat 
    b.good <- rowSums(z2 > 0)==2  &  z2[,1] <= nrow(mat)  &  z2[,2] <= ncol(mat)
    mat[z2[b.good,]]
}

marat = function(mat) {
    n.row = n.col = nrow(mat)
    addresses <- expand.grid(x = 1:n.row, y = 1:n.col)
    # Relative addresses
    z <- rbind(c(-1,0,1,-1,1,-1,0,1), c(-1,-1,-1,0,0,1,1,1))
    apply(addresses, 1,
          get.neighbors, z = z, mat = mat) # Returns a list with neighbors
}

u20650 = function(mat) {
    w <-  which(mat==mat, arr.ind=TRUE)
    d <- as.matrix(dist(w, "maximum", diag=TRUE, upper=TRUE))
    # extract neighbouring values for each element
    # extract where max distance is one
    a <- apply(d, 1, function(i) mat[i == 1] )
    names(a)  <- mat
    return(a)
}
1
有趣的分析。我想知道为什么我的大矩阵运算速度更快，因为你只调用了一次 rbind，这应该意味着分配和复制的操作更少。 - mrip
我也感到惊讶。也许是as.vector转换太慢了？ - Gregor Thomas
1
非常好的回答和出色的工作，但我认为您忘记在mrip函数中更改expand.grid；因此它是最快的。gregor函数实际上要快得多。 - Leonardo
9
这将为您提供一个矩阵，其中每个条目的列对应于其相邻的邻居：
mat <- matrix(1:16, 4, 4)
m2<-cbind(NA,rbind(NA,mat,NA),NA)
addresses <- expand.grid(x = 1:4, y = 1:4)

ret<-c()
for(i in 1:-1)
  for(j in 1:-1)
    if(i!=0 || j !=0)
      ret<-rbind(ret,m2[addresses$x+i+1+nrow(m2)*(addresses$y+j)]) 


> ret
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
[1,]    6    7    8   NA   10   11   12   NA   14    15    16    NA    NA    NA
[2,]    2    3    4   NA    6    7    8   NA   10    11    12    NA    14    15
[3,]   NA   NA   NA   NA    2    3    4   NA    6     7     8    NA    10    11
[4,]    5    6    7    8    9   10   11   12   13    14    15    16    NA    NA
[5,]   NA   NA   NA   NA    1    2    3    4    5     6     7     8     9    10
[6,]   NA    5    6    7   NA    9   10   11   NA    13    14    15    NA    NA
[7,]   NA    1    2    3   NA    5    6    7   NA     9    10    11    NA    13
[8,]   NA   NA   NA   NA   NA    1    2    3   NA     5     6     7    NA     9
     [,15] [,16]
[1,]    NA    NA
[2,]    16    NA
[3,]    12    NA
[4,]    NA    NA
[5,]    11    12
[6,]    NA    NA
[7,]    14    15
[8,]    10    11
你如何调整代码以获取n层邻居？例如，如何增加“ret”变量以包括第二、第三等最近的邻居？ - Rafael
3
也许你可以在这里使用距离函数，利用矩阵元素的行和列索引。
# data
(mat <- matrix(16:31, 4, 4))
     [,1] [,2] [,3] [,4]
[1,]   16   20   24   28
[2,]   17   21   25   29
[3,]   18   22   26   30
[4,]   19   23   27   31

# find distances between row and column indexes
# interested in values where the distance is one
w <-  which(mat==mat, arr.ind=TRUE)
d <- as.matrix(dist(w, "maximum", diag=TRUE, upper=TRUE))

# extract neighbouring values for each element
# extract where max distance is one
a <- apply(d, 1, function(i) mat[i == 1] )
names(a)  <- mat
a

$`16`
[1] "17" "20" "21"

$`17`
[1] "16" "18" "20" "21" "22"

$`18`
[1] "17" "19" "21" "22" "23
... ....
... ....

需要整理，但或许可以给出一些想法。
1
这里是另一种方法：

n.col <- 5
n.row <- 10
mat <- matrix(seq(n.col * n.row), n.row, n.col)

addresses <- expand.grid(x = 1:n.row, y = 1:n.col)

# Relative addresses
z <- rbind(c(-1,0,1,-1,1,-1,0,1),c(-1,-1,-1,0,0,1,1,1))

get.neighbors <- function(rw) {
  # Convert to absolute addresses 
  z2 <- t(z + unlist(rw))
  # Choose those with indices within mat 
  b.good <- rowSums(z2 > 0)==2  &  z2[,1] <= nrow(mat)  &  z2[,2] <=ncol(mat)
  mat[z2[b.good,]]
}

apply(addresses,1, get.neighbors) # Returns a list with neighbors
1

这里还有一个更快的解决方案： 从3D数组R中获取前n个邻居列表

对于大矩阵，这个解决方案要快得多，可以看看我的基准测试结果：

enter image description here

对于小矩阵，我想展示另一个非常有趣的解决方案，它对于小矩阵来说很快，但对于大矩阵来说较慢：
使用复数和abs函数。
get_neighbor <- function(matrix, x=1,y=1){

    z <- complex(real = rep(1:nrow(matrix), ncol(matrix)),
                 imaginary = rep(1:ncol(matrix), each = nrow(matrix)))

    lookup <- lapply(seq_along(z), function(x){
      ## calculate distance
      dist <- which(abs(z - z[x]) < 2)
      ## remove those with dist == 0 -> it´s the number itself
      dist[which(dist != x)]
    })
    index <- (y-1)*(nrow(matrix))+x
    matrix[lookup[[index]]]

}

enter image description here

1
我们可以尝试以下基本的R代码。
f <- Vectorize(function(mat, x, y) {
  X <- pmin(pmax(x + c(-1:1), 1), nrow(mat))
  Y <- pmin(pmax(y + c(-1:1), 1), ncol(mat))
  mat[as.matrix(subset(
    unique(expand.grid(X = X, Y = Y)),
    !(X == x & Y == y)
  ))]
},vectorize.args = c("x","y"))

neighbors <- with(addresses, f(mat,x,y))

而我们将会看到

> head(neighbors)
[[1]]
[1]  2 11 12

[[2]]
[1]  1  3 11 12 13

[[3]]
[1]  2  4 12 13 14

[[4]]
[1]  3  5 13 14 15

[[5]]
[1]  4  6 14 15 16

[[6]]
[1]  5  7 15 16 17
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接