[英]how to select neighbouring elements in a vector and put them into a list or matrix in R
[英]find neighbouring elements of a matrix in R
編輯:非常感謝以下用戶的巨大貢獻和 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])
}
當它碰到矩陣的邊緣時會遇到問題,特別是當索引大於矩陣的邊緣時。
這是一個很好的例子。 我做了4x4所以我們可以很容易地看到它,但它都可以通過n
調整。 它也完全矢量化,所以應該具有良好的速度。
n = 4
mat = matrix(1:n^2, nrow = n)
mat.pad = rbind(NA, cbind(NA, mat, NA), NA)
使用填充矩陣,鄰居只有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)
}
這將為您提供一個矩陣,其中的列對應於矩陣中每個條目的鄰居:
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.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
也許您可以使用矩陣元素的行和列索引來使用距離函數。
# 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
... ....
... ....
需要整理,但可能會提出一個想法
這里也發布了一個更快的解決方案: List of n first Neighbors from a 3d Array R
對於大型矩陣,此解決方案要快得多,請在此處查看我的基准測試:
對於小矩陣,我想展示另一個非常有趣的解決方案,它對小矩陣來說很快,但對大矩陣來說很慢:
使用復數和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]]]
}
我們可以嘗試以下基本 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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.