Reputation: 75

Identify all elements adjacent to a 1 in a binary matrix

I'm trying to create a function where at every time step in a matrix, the cells adjacent and diagonal to a 1 become 1 as well. For example, something like this:

Input

Output after first time step

So far, I have this:

A = matrix(0,nrow=5,ncol=5)

A[2,2]=1


for (i in 1:5){
for (j in 1:5){
  if ((A[i,j]==1)) {
    A[,(j+1)]=1
    A[,(j-1)]=1
    A[(i+1),]=1
    A[(i-1),]=1
    A[(i+1),(j+1)]=1
    A[(i+1),(j-1)]=1
    A[(i-1),(j+1)]=1
    A[(i-1),(j-1)]=1
}
}
}

I'm not too sure how to integrate a function in there, so I can have the resulting matrix for whatever time step I want.

Upvotes: 3

Answers (3)

Julius Vainora

Reputation: 48221

This works for multiple 1's in the initial matrix that also can be in the first/last column/row.

A <- matrix(0, nrow = 5, ncol = 5)
A[2, 2] <- 1
A[5, 5] <- 1
A
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    0    0    0    0    0
# [2,]    0    1    0    0    0
# [3,]    0    0    0    0    0
# [4,]    0    0    0    0    0
# [5,]    0    0    0    0    1

spread <- function(x) {
  idx <- do.call(rbind, apply(which(x == 1, arr.ind = TRUE), 1, 
                              function(y) expand.grid(y[1] + 1:-1, y[2] + 1:-1)))
  idx <- idx[!(idx[, 1] %in% c(0, nrow(x) + 1) | idx[, 2] %in% c(0, ncol(x) + 1)), ]
  x[as.matrix(idx)] <- 1
  x
}

spread(A)
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    1    1    0    0
# [2,]    1    1    1    0    0
# [3,]    1    1    1    0    0
# [4,]    0    0    0    1    1
# [5,]    0    0    0    1    1

spread(spread(A))
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    1    1    1    0
# [2,]    1    1    1    1    0
# [3,]    1    1    1    1    1
# [4,]    1    1    1    1    1
# [5,]    0    0    1    1    1

Edit:

Here is a function with a parameter k (taking values 1, 2, ...) that denotes the step of spreading 1's:

spread <- function(x, k) {
  idx <- do.call(rbind, apply(which(x == 1, arr.ind = TRUE), 1, 
                              function(y) expand.grid(y[1] + k:-k, y[2] + k:-k)))
  idx <- idx[idx[, 1] %in% 1:nrow(x) & idx[, 2] %in% 1:ncol(x), ]
  x[as.matrix(idx)] <- 1
  x
}
spread(A, 2)
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    1    1    1    0
# [2,]    1    1    1    1    0
# [3,]    1    1    1    1    1
# [4,]    1    1    1    1    1
# [5,]    0    0    1    1    1

Upvotes: 2

Jacob H

Reputation: 4513

This works but might need some retooling for more general cases, i.e. your going to run into problems with multiple 1 in the initial matrix. If such a generalization is required please let me know and I'll gladly attempt to produce one. Or just use either josilber's or Julius's answer.

M <- as.matrix(read.table(textConnection("0 0 0 0 0
0 1 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0")))

my_spread <- function(m){

 e <- which(m == 1, arr.ind = TRUE)

 r <- c(e[, 1] - 1, e[, 1], e[, 1] + 1)
 l <- c(e[, 2] - 1, e[, 2], e[, 2] + 1)

 #dealing with border cases
 r <- r[nrow(m) >= r]
 l <- l[ncol(m) >= l]

 m[as.matrix(expand.grid(r,l))] <- 1
 m
}

my_spread(M)
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    1    1    0    0
[2,]    1    1    1    0    0
[3,]    1    1    1    0    0
[4,]    0    0    0    0    0
[5,]    0    0    0    0    0
my_spread(my_spread(M))
      [,1] [,2] [,3] [,4] [,5]
[1,]    1    1    1    1    0
[2,]    1    1    1    1    0
[3,]    1    1    1    1    0
[4,]    1    1    1    1    0
[5,]    0    0    0    0    0
my_spread(my_spread(my_spread(M)))
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    1    1    1    1
[2,]    1    1    1    1    1
[3,]    1    1    1    1    1
[4,]    1    1    1    1    1
[5,]    1    1    1    1    1

Upvotes: 0

josliber

Reputation: 44330

You could determine if a bit is set either in the matrix or the matrix when it is shifted in any of the 8 legitimate directions (right, left, up, down, up-right, down-right, down-left, up-left):

spread <- function(X) unname(X |
   rbind(F, head(X, -1)) |
   rbind(tail(X, -1), F) | 
   cbind(F, X[,-ncol(X)]) |
   cbind(X[,-1], F) |
   cbind(F, rbind(F, head(X, -1))[,-ncol(X)]) |
   cbind(rbind(F, head(X, -1))[,-1], F) |
   cbind(F, rbind(tail(X, -1), F)[,-ncol(X)]) |
   cbind(rbind(tail(X, -1), F)[,-1], F)) * 1
X <- matrix(rep(c(0, 1, 0), c(6, 1, 18)), nrow=5)
spread(X)
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    1    1    0    0
# [2,]    1    1    1    0    0
# [3,]    1    1    1    0    0
# [4,]    0    0    0    0    0
# [5,]    0    0    0    0    0

You can apply the function repeatedly to further spread the data:

spread(spread(X))
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    1    1    1    0
# [2,]    1    1    1    1    0
# [3,]    1    1    1    1    0
# [4,]    1    1    1    1    0
# [5,]    0    0    0    0    0
spread(spread(spread(X)))
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    1    1    1    1
# [2,]    1    1    1    1    1
# [3,]    1    1    1    1    1
# [4,]    1    1    1    1    1
# [5,]    1    1    1    1    1

Upvotes: 3

Identify all elements adjacent to a 1 in a binary matrix

Answers (3)

Related Questions