Making a chess matrix - r

So I'm using r and I'd like to make a code that takes a value of n, creates a n x n matrix that has alternating 1's and 0's.
E.g:
I can't seem to do this without getting an error or warning and it won't work for all integers of n, any help would be appreciated, thanks.


what about this?
n <- 5L
matrix(seq(1:n^2) %% 2, nrow = n)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 1 0 1
[2,] 0 1 0 1 0
[3,] 1 0 1 0 1
[4,] 0 1 0 1 0
[5,] 1 0 1 0 1


Try the code below
m <- matrix(rep_len(c(1, 0), n^2), n)
or
m <- replace(m <- diag(n), !((row(m) - col(m)) %% 2), 1)
which gives
> m
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 1 0 1
[2,] 0 1 0 1 0
[3,] 1 0 1 0 1
[4,] 0 1 0 1 0
[5,] 1 0 1 0 1

Related

How to set all rows of a list of matrices to zero using if condition statement in R

Suppose I have a matrix, mat. Suppose further that the sum of one row of this matrix is equal to zero. Then, I need to set all the coming rows (the rows after the zero row) to zero. For example,
mat <- c(1,2,0,0,0,
3,4,0,2,1,
0,0,0,1,0,
1,2,0,0,0,
0,1,0,1,0)
mat <- matrix(mat,5,5)
mat
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 1
[3,] 0 0 0 0 0
[4,] 0 2 1 0 1
[5,] 0 1 0 0 0
All the entries of row 3 are zero. Hence, I want rows 4, and 5 to become zeros as well. I have a list of matrices and would like to apply the same to all the matrices using the lapply function. For simplicity, I make a list of 3 matrices similar to the mat.
mat <- c(1,2,0,0,0,
3,3,0,2,1,
0,0,0,4,0,
1,3,0,0,0,
0,1,0,1,0)
mat <- matrix(mat,5,5)
mat1 <- c(1,2,0,0,0,
3,4,0,2,1,
0,0,0,1,0,
1,2,0,0,0,
0,1,0,1,0)
mat1 <- matrix(mat1,5,5)
mat2 <- c(1,2,0,0,0,
3,4,0,2,1,
0,0,0,2,0,
1,2,0,0,0,
0,2,0,3,0)
mat2 <- matrix(mat2,5,5)
Mat <- list(mat1, mat2, mat3)

You did not actually post mat3 in your data so I just used mat3 <- matrix(1, 5, 5), i.e. a 5x5 matrix of ones. This was to ensure it could handle cases where there is no row where all values are zero.
This will return a list of matrices where all rows are zero after the first row of zeroes:
lapply(Mat, \(mat) {
first_zero_row <- which(rowSums(mat)==0)[1]
if(!is.na(first_zero_row)) {
mat[first_zero_row:nrow(mat),] <- 0
}
mat
})
Output:
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 1
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 2
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[3]]
[,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

Another option could be:
lapply(Mat, function(x) {x[cumsum(rowSums(x != 0) == 0) != 0, ] <- 0; x})
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 3 0 3 1
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 1
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[3]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 2
[3,] 0 0 0 1 0
[4,] 0 2 2 0 3
[5,] 0 1 0 0 0

producing a full adjacency matrix from partial information

I have a matrix that contains all the info necessary to construct 5x5 adjacency matrices. Each row represents one matrix:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 1 1 1 1 1 0 1 0
[2,] 0 0 0 1 1 1 1 0 1 0
...
I want to create an adjacency matrix from the nth row of data. For the first row of have, the want matrix would look like this:
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 1 1 1
[2,] 1 0 1 1 1
[3,] 1 1 0 0 1
[4,] 1 1 0 0 0
[5,] 1 1 1 0 0
How do I get from have to want?

Here is an option using lower.tri and upper.tri
unlist(apply(mat, 1, function(x) {
m <- matrix(0, nrow = 5, ncol = 5)
m[lower.tri(m)] <- x
m[upper.tri(m)] <- x
list(m)
}), recursive = F)
#[[1]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 1 1 1
#[2,] 1 0 1 1 0
#[3,] 1 1 0 1 1
#[4,] 1 1 0 0 0
#[5,] 1 1 1 0 0
#
#[[2]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 1 1
#[2,] 0 0 0 1 0
#[3,] 0 1 0 1 1
#[4,] 0 1 0 0 0
#[5,] 1 1 1 0 0
The unlist(..., recursive = F) part seems somewhat awkward but is necessary to prevent apply from simplifying the result and dropping dims. An alternative would be to use lapply on a data.frame instead of a matrix:
lapply(as.data.frame(t(mat)), function(x) {
m <- matrix(0, nrow = 5, ncol = 5)
m[lower.tri(m)] <- x
m[upper.tri(m)] <- x
return(m)
})
giving the same result.
Sample data
mat <- as.matrix(read.table(text =
"1 1 1 1 1 1 1 0 1 0
0 0 0 1 1 1 1 0 1 0", header = F))
colnames(mat) <- NULL

Working with matrix in R. Place an element in matrix

I have a distance matrix. For example :
d<-matrix(c(0,2,3,7,11,0,13,6,8,5,0,12,6,53,12,0), nrow = 4, ncol = 4)
d
[,1] [,2] [,3] [,4]
[1,] 0 11 8 6
[2,] 2 0 5 53
[3,] 3 13 0 12
[4,] 7 6 12 0
I want to create a neighbor matrix where distance is less than or equal to 5. In matrix nb, 1 indicates not a neighbor. However, they have no neighbor (excluding itself, for example, row 1 and row 4. I would like the one with the smallest distance to be their neighbor.
> nb=(d>=5)
> nb*1
[,1] [,2] [,3] [,4]
[1,] 0 1 1 1
[2,] 0 0 1 1
[3,] 0 1 0 1
[4,] 1 1 1 0
Expected result
[,1] [,2] [,3] [,4]
[1,] 0 1 1 0
[2,] 0 0 1 1
[3,] 0 1 0 1
[4,] 1 0 1 0
I have tried and I don't know how to get it efficiently without using loop. This is just an example, my actual data has over 9000 rows. Any suggestion would be helpful. Thank you so much!

I believe the following function does what you want.
fun <- function(Dist, n = 5){
nb <- (Dist > n)*1L
for(i in seq_len(nrow(nb))) {
tmp <- Dist[i, ]
tmp[tmp == 0] <- Inf
nb[i, which.min(tmp)] <- 0L
}
nb
}
fun(d)
# [,1] [,2] [,3] [,4]
#[1,] 0 1 1 0
#[2,] 0 0 0 1
#[3,] 0 1 0 1
#[4,] 1 0 1 0
fun(d, 10)
# [,1] [,2] [,3] [,4]
#[1,] 0 1 0 0
#[2,] 0 0 0 1
#[3,] 0 1 0 1
#[4,] 0 0 1 0

How to create a matrix with zeroes in blocks within the diagonal?

So I'm trying to create a 2000 * 2000 matrix that has 50*50 blocks of zeroes along the diagonal, and 1's everywhere else.
Here is a miniature example of what I mean. a is a 6x6 matrix with 1's and each block is a 2*2 matrix with zeroes along the diagonal
a <- matrix(rep(1, times = 36), nrow = 6, byrow = TRUE)
a[1:2,1:2] <- 0
a[3:4,3:4] <- 0
a[5:6,5:6] <- 0
giving
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 1 1 1 1
[2,] 0 0 1 1 1 1
[3,] 1 1 0 0 1 1
[4,] 1 1 0 0 1 1
[5,] 1 1 1 1 0 0
[6,] 1 1 1 1 0 0
Of course my choice of code is bad for creating such a big matrix, as I would have to repeat the bottom part 50 times.
What would be a much better code to create this type of matrix?

rawr is correct,
a <- +!kronecker(diag(1, 3), matrix(1, 2, 2))
gives
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 1 1 1 1
[2,] 0 0 1 1 1 1
[3,] 1 1 0 0 1 1
[4,] 1 1 0 0 1 1
[5,] 1 1 1 1 0 0
[6,] 1 1 1 1 0 0
and +!kronecker(diag(1, 40), matrix(1, 50, 50)) solves my original question with the 2000*2000 matrix

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

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

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

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

Resources