найти соседние элементы матрицы в R

Изменить: огромное спасибо пользователям ниже за большой вклад и Грегору за сравнительный анализ.

Скажем, у меня есть матрица, заполненная такими целочисленными значениями ...

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

Я могу создать список координат x, y каждого элемента следующим образом ...

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

Теперь для каждой из этих координат (т.е. для каждого элемента в мате) я хотел бы найти соседние элементы (включая диагонали, это должно сделать 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])
    }

Это вызывает проблемы, когда попадает на край матрицы, особенно когда индекс больше, чем край матрицы.


person roman    schedule 17.03.2015    source источник
comment
Что вы хотите сделать по краям? Вы можете обернуть и рассмотреть левый край, смежный с правым, или вы можете вернуть NA, или, может быть, что-то еще.   -  person Gregor Thomas    schedule 17.03.2015
comment
Если ответ - NA, вы можете избежать особой обработки в коде, если дополните свою матрицу NAs (сделайте его 12x12 с первой и последней строкой и столбцом со всеми NA), тогда вы можете просто посмотреть на всех соседей середина.   -  person Gregor Thomas    schedule 17.03.2015
comment
на данный момент я просто хочу вернуть NA   -  person roman    schedule 17.03.2015
comment
спасибо Грегор, я выберу вариант заполнения.   -  person roman    schedule 17.03.2015
comment
отлично, спасибо mrip и Gregor, оба очень полезны   -  person roman    schedule 17.03.2015


Ответы (4)


Вот хороший пример. Я сделал 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 Гб, и я также вынул ответ Марата, подождав около 10 минут.

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)
}
person Gregor Thomas    schedule 17.03.2015
comment
Интересный и хороший анализ. Интересно, почему мой быстрее для больших матриц, я бы подумал, что ваш будет, потому что есть только один вызов rbind, что должно означать меньшее выделение и копирование. - person mrip; 18.03.2015
comment
Я тоже был удивлен. Может, as.vector преобразование идет медленно? - person Gregor Thomas; 18.03.2015
comment
Отличный ответ и отличная работа, но я думаю, вы забыли изменить expand.grid в функции mrip; по этой причине он самый быстрый. gregor на самом деле намного быстрее. - person Leonardo; 22.01.2021

Это даст вам матрицу со столбцами, соответствующими соседям каждой записи в матрице:

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
person mrip    schedule 17.03.2015
comment
как вы могли настроить это, чтобы получить n-глубину соседей. например, чтобы увеличить ret, чтобы также включить второго, третьего и т.д. ближайших соседей? - person Rafael; 02.12.2019

Вот еще один подход:

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
person Marat Talipov    schedule 17.03.2015

Возможно, вы сможете использовать здесь функцию расстояния, используя индексы строк и столбцов элементов матрицы.

# 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
... ....
... ....

Необходимо привести в порядок, но, возможно, дает представление

person user20650    schedule 17.03.2015