Identify all elements adjacent to a 1 in a binary matrix - r

Question

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
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
Output after first time step
1 1 1 0 0
1 1 1 0 0
1 1 1 0 0
0 0 0 0 0
0 0 0 0 0
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.

Answer 1

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

Answer 2

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

Answer 3

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