Get distance to non zero neighbor in a matrix

Question

Can anyone tell me a smart way how to calculate the distance to the non-zero neighbors in a sparse matrix? The reason to do this is that I want to identify "holes" in a large, multidimensional matrix.

As an example: Let's assume I have a 10x10 Matrix filled with a lot of zeros and some 1s:

f<-ceiling((runif(100,0,1))-.6)
a <- matrix(f, ncol=10L, nrow=10L)
rownames(a) = seq(1,10,1)
colnames(a) = seq(1,10,1)

a could be

> a
   1 2 3 4 5 6 7 8 9 10
1  0 0 0 0 1 0 0 1 1  0
2  1 0 0 0 1 0 0 0 0  0
3  0 1 1 0 1 1 0 0 1  1
4  0 0 1 1 0 1 0 1 0  0
5  0 0 0 1 0 1 0 0 0  1
6  1 0 0 0*0*1 0 1 0  0
7  0 1 1 1 1 1 1 0 1  0
8  1 0 1 0 1 0 0 0 1  1
9  1 1 1 0 0 0 0 0 0  0
10 1 1 1 1 1 0 1 0 1  0

What I need as a result is a 10x10 Matrix with the mean distance of all four directions (two for each dimension) for all zero points.

E.g. point a[6,5] is zero and has 4 neighbors. The distance to the left is 5, to the right is 1, up is 3 and down is 1. So the mean would be 2,5. If neighbors do not exist, the mean should be calculated for the remaining neighbors.

As usual, my first idea was a bunch of for loops, looking for each matrix value in all directions and return the distances. But this must be the dumbest way to do it...

In your example, I think the distance to the left is 4, not 5. — David Marx, Aug 01 '13 at 21:17
I do think you will need some function like `apply` or `outer` to at least implicitly loop over the 10 x 10 range. — IRTFM, Aug 01 '13 at 23:08

score 1 · Accepted Answer · edited May 23 '17 at 10:25

I liked that problem a lot! Here is a solution, not necessarily fast but it does the job.

First let's recreate your data:

a <- matrix(scan(textConnection("
  0 0 0 0 1 0 0 1 1  0
  1 0 0 0 1 0 0 0 0  0
  0 1 1 0 1 1 0 0 1  1
  0 0 1 1 0 1 0 1 0  0
  0 0 0 1 0 1 0 0 0  1
  1 0 0 0 0 1 0 1 0  0
  0 1 1 1 1 1 1 0 1  0
  1 0 1 0 1 0 0 0 1  1
  1 1 1 0 0 0 0 0 0  0
  1 1 1 1 1 0 1 0 1  0
")), 10, 10, byrow = TRUE)

Here, let's split your rows and columns into four oriented lists of vectors:

rev.list <- function(l) lapply(l, rev)

v1 <- split(a, row(a))  # rows left to right
v2 <- rev.list(v1)      # rows right to left
v3 <- split(a, col(a))  # cols up to down
v4 <- rev.list(v3)      # cols down to up

Here we create and apply a function (inspired from https://stackoverflow.com/a/17929557/1201032) for computing one-directional distances:

dir.dist <- function(v) {
  out <- seq_along(v) - cummax(seq_along(v) * v)
  out[seq_len(match(1, v) - 1)] <- NA
  out
}

dist1.list <- lapply(v1, dir.dist) # dist to closest on left
dist2.list <- lapply(v2, dir.dist) # dist to closest on right
dist3.list <- lapply(v3, dir.dist) # dist to closest up
dist4.list <- lapply(v4, dir.dist) # dist to closest dn

Now let's put everything back into four matrices:

nr <- nrow(a)
nc <- ncol(a)

list.to.mat <- function(l, revert = FALSE, byrow = FALSE,
                           nrow = nr, ncol = nc) {
  x <- unlist(if (revert) rev.list(l) else l)
  matrix(x, nrow, ncol, byrow)
}

m1 <- list.to.mat(dist1.list, revert = FALSE, byrow = TRUE)
m2 <- list.to.mat(dist2.list, revert = TRUE,  byrow = TRUE)
m3 <- list.to.mat(dist3.list, revert = FALSE, byrow = FALSE)
m4 <- list.to.mat(dist4.list, revert = TRUE,  byrow = FALSE)

Finally, let's compute the means using a pmean function inspired from https://stackoverflow.com/a/13123779/1201032:

pmean <- function(..., na.rm = FALSE) { 
  dat <- do.call(cbind, list(...))
  res <- rowMeans(dat, na.rm = na.rm) 
  idx_na <- !rowSums(!is.na(dat))
  res[idx_na] <- NA
  res 
}

final <- matrix(pmean(as.vector(m1),
                      as.vector(m2),
                      as.vector(m3),
                      as.vector(m4), na.rm = TRUE), nr, nc)

final
#       [,1] [,2] [,3] [,4]  [,5]  [,6] [,7] [,8] [,9] [,10]
#  [1,] 2.50 2.50 2.00 2.00  0.00  1.67 3.00  0.0 0.00 1.50
#  [2,] 0.00 1.67 1.67 2.00  0.00  1.00 3.50  2.0 2.00 3.00
#  [3,] 1.67 0.00 0.00 1.00  0.00  0.00 2.33  1.5 0.00 0.00
#  [4,] 2.00 1.67 0.00 0.00  1.50  0.00 1.67  0.0 1.67 1.33
#  [5,] 2.33 2.00 1.33 0.00  1.50  0.00 2.00  1.5 2.00 0.00
#  [6,] 0.00 2.25 2.00 1.75 *2.25* 0.00 1.00  0.0 1.67 1.67
#  [7,] 1.00 0.00 0.00 0.00  0.00  0.00 0.00  1.0 0.00 1.33
#  [8,] 0.00 1.00 0.00 1.25  0.00  1.67 1.75  2.0 0.00 0.00
#  [9,] 0.00 0.00 0.00 1.33  1.33  2.50 2.33  4.0 2.67 4.00
# [10,] 0.00 0.00 0.00 0.00  0.00  1.67 0.00  2.0 0.00 1.50

This looks impressive, thanks a lot for your effort, flodel. I will go through it and let you know if it works for my original problem. — Jochen Döll, Aug 02 '13 at 05:58

score 0 · Answer 2 · answered Aug 01 '13 at 23:04

0

For your matrix you can convert to sparse r x c form with which:

rc <- which(a>0, arr.ind=TRUE)
rc[rc[,1] == 6, 2]   # 1, 6,8   candidates for "row-neighbors"
rc[rc[,2] == 5, 1]   # 1,2,3, 7,8,10  col-neighbors

answered Aug 01 '13 at 23:04

IRTFM

258,963
21
364
487

The "candidates for neighbors are a nice intermediate result. I will try this, too. Thank you DWin! – Jochen Döll Aug 02 '13 at 06:03

Get distance to non zero neighbor in a matrix

2 Answers2