How would I find the number of 1s that are connected by 6 or more 1s in a data frame?

Question

I have my attempt to find the number of 1s connected by 6 or more other 1s below...

6_or_more <- function(x) {
  diff <- diff(x) == 0
 (c(0,diff) + c(diff,0)) * x
}

mat <-matrix(rbinom(10 * 5, 1, 0.5), ncol = 20, nrow = 20)
with(rle(as.vector(mat)), sum(lengths[values == 1] >= 5))

6_or_more_rows_columns <- lapply(files, function(y) sum(t(apply(y, 1, 6_or_more)) + apply(y, 2, 6_or_more) >= 6))

6_or_more_neighbours_data <- t(data.frame(6_or_more_rows_columns))
rownames(6_or_more_neighbours_data) <- NULL

6_or_more_neighbours <- 6_or_more_neighbours_data
6_or_more_neighbours

But this is outputted 0 as it is only checking to the top, bottom, left and right of each 1. How would I update this code to get it to check diagonally to each 1 too?

You should make a reproducible example. Within your ```sum()``` call, you may be able to add something about ```diag(y)``` which would only check the main diagonal. — Cole, Oct 20 '19 at 15:21

score 1 · Accepted Answer · 2019-10-30T13:36:34.973

You might try gathering all consecutive values (left to right, top to bottom, and diagonal) in a list and then call rle on each list element. For example, using the following data:

set.seed(30948)
mat <- matrix(rbinom(10 * 5, 1, 0.5), ncol = 20, nrow = 20)

Combine rows, columns, and bottom-left and top-right diagonals in consecs, then call rle on each element and return the sum. I retrieve all the diagonals by calling diag on subsets of mat. Note that the corners are ignored because of 1:(ncol(mat)-1), and that I drop the first diagonal of the bottom-left corner with [-1] because it is already extracted in the prior lapply:

consecs <- c(lapply(1:ncol(mat), function(x) mat[, x]),
             lapply(1:nrow(mat), function(x) mat[x, ]),
             lapply(1:(ncol(mat)-1), function(x) diag(mat[, x:ncol(mat)])),
             lapply(1:(nrow(mat)-1), function(x) diag(mat[x:nrow(mat), ]))[-1]
             )

sum(sapply(consecs, function(x) with(rle(x), sum(lengths[values == 1] > 5))))

#[1] 14

Edit:

I gather from your comments that you want apply the above code to a list of matrices. To do that just put the code in a function and pass it into lapply:

# Create a list of matrices.
set.seed(30948)
mat_list <- list(mat1 = matrix(rbinom(10 * 5, 1, 0.5), ncol = 20, nrow = 20),
                 mat2 = matrix(rbinom(10 * 5, 1, 0.5), ncol = 20, nrow = 20),
                 mat3 = matrix(rbinom(10 * 5, 1, 0.5), ncol = 20, nrow = 20)
                 )

# Put the above code in a function.
compute_consecs <- function(mat){
    consecs <- c(lapply(1:ncol(mat), function(x) mat[, x]),
                 lapply(1:nrow(mat), function(x) mat[x, ]),
                 lapply(1:(ncol(mat)-1), function(x) diag(mat[, x:ncol(mat)])),
                 lapply(1:(nrow(mat)-1), function(x) diag(mat[x:nrow(mat), ]))[-1]
    )

    sum(sapply(consecs, function(x) with(rle(x), sum(lengths[values == 1] > 5))))
}

# Apply the function to your list of matrices.
lapply(mat_list, compute_consecs)

#### OUTPUT ####

$mat1
[1] 14

$mat2
[1] 0

$mat3
[1] 7

I have tried out your code above using your example but when I check the matrix and run the sum sapply I get an output of more than 14? — Jordan, Oct 22 '19 at 09:45
@Jordan did you also run `set.seed`? If not then you'll get a different answer each time because of `rbinom`. — , Oct 22 '19 at 10:08
@Jordan it's also possible that we are using different version of R, in which case `set.seed` isn't consistent as of R 3.6. For reference read https://stackoverflow.com/questions/47199415/is-set-seed-consistent-over-different-versions-of-r-and-ubuntu. I recommend testing the code on a smaller matrix that you can manually check. — , Oct 22 '19 at 10:12
This is great - thanks so much! How would I perform this on a list? Would I wrap the whole thing in an lapply function or how would I do it? @gersht — Jordan, Oct 30 '19 at 10:56
@Jordan assuming you mean a list of matrices then yes, you can use `lapply`. Just put the above code in the function you pass into `lapply`. — , Oct 30 '19 at 11:18
@Jordan also, if my answer helped you then please consider upvoting it, and if it solves your problem then press the ✓ to accept it so others with the same question know what worked for you. — , Oct 30 '19 at 11:20
@Jordan no problem. I've added some code to deal with lists of matrices. It looks like you did the same thing, so there shouldn't be any errors. Compare my input list `mat_list` with your `files`. Is `files` a list of matrices? The error suggests it isn't. — , Oct 30 '19 at 13:40

How would I find the number of 1s that are connected by 6 or more 1s in a data frame?

1 Answers1