Search code examples
rmatrixtile

Trying to find the number of diagonals of 1 in each 3x3 tile in a 15x15 binary matrix?


I am trying to find the count of diagonal 1s in each 3x3 tile e.g.

0 0 1         1 0 0
0 1 0         0 1 0
1 0 0    or   0 0 1

from the below 15x15 matrix.

set.seed(99)
mat <- matrix(sample(c(0,1), 225, prob=c(0.8,0.2), replace=TRUE), nrow=15)
print(mat)

    [,1][,2][,3][,4][,5][,6][,7][,8][,9][,10][,11][,12][,13][,14][,15]
[1,]  0   0   1   0   0   0   0   0   0    0    0    0    0    0   0
[2,]  0   1   0   1   0   0   1   0   0    0    1    0    0    0   1
[3,]  0   0   0   1   0   0   0   0   1    0    0    1    0    0   0
[4,]  0   0   0   0   0   0   0   1   1    0    0    0    0    0   1
[5,]  0   0   0   0   1   0   0   1   1    1    0    0    0    0   0
[6,]  0   0   0   0   0   0   1   0   0    0    0    0    1    0   0
[7,]  0   0   0   0   0   0   0   0   0    0    0    0    0    0   0
[8,]  0   0   0   0   0   0   0   1   0    1    0    0    0    0   0
[9,]  0   0   0   0   0   1   0   0   1    1    0    0    1    0   1
[10,] 0   0   0   0   0   0   0   0   1    0    1    1    0    1   0
[11,] 0   0   0   0   0   0   1   0   0    1    0    1    0    0   0
[12,] 0   0   0   0   0   0   1   0   0    1    0    0    0    0   0
[13,] 0   0   0   0   0   1   0   1   0    0    1    0    1    0   0
[14,] 1   1   0   1   1   0   0   0   0    1    0    0    0    0   1
[15,] 1   0   1   0   1   1   0   0   0    1    0    1    0    0   0

I expect the output to be 2 for the above matrix. Is there a way to do this with a for loop and if statements?


Solution

  • Here's a nested for loop (using sapply()). Note I did not have the same dataset as you so there's a different seed.

    set.seed(123)
    mat <- matrix(sample(c(0,1), 225, prob=c(0.8,0.2), replace=TRUE), nrow=15)
    
    n_by_n <- 3L
    
    reg_diag <- diag(n_by_n)
    rev_diag <- reg_diag[nrow(reg_diag):1, ]
    
    sum(
      sapply(seq_len(ncol(mat)- n_by_n + 1),
           function(col) {
             sapply(seq_len(nrow(mat) - n_by_n + 1),
                    function(row) {
                      tmp <- mat[row:(row + n_by_n - 1), col:(col + n_by_n - 1)]
                      all(tmp == reg_diag) | all(tmp == rev_diag)
                    })
           })
    )
    
    #[1] 1
    

    If you are only interested in diagonals and do not care about the other values in a submatrix, this splits the matrix by each diagonal and then calculated a rolling sum to see if they sum up to 3:

    library(RcppRoll)
    
    set.seed(99)
    mat <- matrix(sample(c(0,1), 225, prob=c(0.8,0.2), replace=TRUE), nrow=15)
    
    n_by_n <- 3
    
    diags <- row(mat)- col(mat)
    cross_diags <- row(mat) + col(mat)
    
    #could use data.table::frollsum instead of RcppRoll::roll_sumr)
    sum(unlist(lapply(split(mat, diags), RcppRoll::roll_sumr, n_by_n), use.names = F) == n_by_n, na.rm = T)
    #[1] 1
    
    sum(unlist(lapply(split(mat, cross_diags), RcppRoll::roll_sumr, n_by_n), use.names = F) == n_by_n, na.rm = T)
    # [1] 3
    

    A complete base approach would be:

    base_rollr <- function(x, roll) {
     #from user @flodel  
        if (length(x) >= roll)  tail(cumsum(x) - cumsum(c(rep(0, roll), head(x, -roll))), -roll + 1)
    }
    
    sum(unlist(lapply(split(mat, cross_diags), base_rollr, n_by_n), use.names = F) == n_by_n, na.rm = T)
    

    See also: Get all diagonal vectors from matrix

    And: Consecutive/Rolling sums in a vector in R