una - sustituir na por 0 en r

Extrae submatrices de la matriz binaria en R

Question

Diga la matriz binaria m :

      # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 # [1,]    0    0    0    0    0    0    0    0    0
 # [2,]    0    0    0    0    0    0    0    0    0
 # [3,]    0    0    0    1    1    1    1    0    0
 # [4,]    0    0    0    1    1    1    1    0    0
 # [5,]    0    0    0    1    1    1    1    0    0
 # [6,]    0    0    0    0    0    0    0    0    0
 # [7,]    0    1    1    0    0    0    0    1    1
 # [8,]    0    1    1    0    1    1    0    1    1
 # [9,]    0    0    0    0    1    1    0    1    1
# [10,]    0    0    0    0    1    1    0    0    0

m <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 
1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 
0, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 
1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 
0, 0, 0, 0, 0, 0, 1, 1, 1, 0), .Dim = c(10L, 9L))

¿Cómo podemos extraer esas submatrices de 1 ? p.ej

m[7:9,8:9]

#     [,1] [,2]
#[1,]    1    1
#[2,]    1    1
#[3,]    1    1

El punto es que quiero extraerlos algorítmicamente sin indexarlos explícitamente como m[7:9,8:9] .

• La entrada es una matriz binaria
• Lista de submatrices como salida (así que lista de cuatro matrices de dim 3*4 , 2*2 , 3*2 y 3*2 )
• Las submatrices son rectangulares con 1
• El borde de las submatrices está asegurado con ceros.

Answer 1

Lo trataría como un problema espacial en el que tiene un ráster y desea detectar regiones de celdas conectadas.

library(raster)
r <- raster(m)

library(igraph)
rc <- clump(r)

plot(rc, col = rainbow(rc@data@max))

m1 <- as.matrix(rc)

lapply(seq_len(rc@data@max), function(x) {
  inds <- which(m1 == x, arr.ind = TRUE)
  nrow <- diff(range(inds[, "row"])) + 1
  ncol <- diff(range(inds[, "col"])) + 1
  matrix(1, ncol = ncol, nrow = nrow)
})
#[[1]]
#     [,1] [,2] [,3] [,4]
#[1,]    1    1    1    1
#[2,]    1    1    1    1
#[3,]    1    1    1    1
#
#[[2]]
#     [,1] [,2]
#[1,]    1    1
#[2,]    1    1
#
#[[3]]
#     [,1] [,2]
#[1,]    1    1
#[2,]    1    1
#[3,]    1    1
#
#[[4]]
#     [,1] [,2]
#[1,]    1    1
#[2,]    1    1
#[3,]    1    1

Answer 2

Use focal en el paquete de ráster con una matriz de ponderación adecuada w . Eso. Convuela w con m dando a una matriz las mismas dimensiones que m con el valor de big en cada esquina superior izquierda y otros valores en otro lugar, por lo que al compararla con big obtiene una matriz lógica TRUE en las esquinas superiores izquierdas de los rectángulos. Con el which obtenemos rc que tiene una fila por rejilla y dos columnas que representan las coordenadas i y j de la esquina superior izquierda de ese rectángulo. La llamada al Map itera sobre las coordenadas superiores izquierdas que invocan genmap en cada una. genmap usa rle (como se define en la función rl ) para encontrar la longitud de la ejecución de unos en cada dirección de coordenadas y devuelve una matriz de los que tienen esas dimensiones.

library(raster)

big <- 100
r <- raster(m)
w <- matrix(0, 3, 3); w[1:2, 1:2] <- 1; w[2, 2] <- big
rc <- which(as.matrix(focal(r, w, pad = TRUE, padValue = 0)) == big, arr = TRUE)

rl <- function(x) rle(x)$lengths[1]
genmat <- function(i, j) matrix(1, rl(m[i:nrow(m), j]), rl(m[i, j:ncol(m)]))
Map(genmat, rc[, 1], rc[, 2])

dando:

[[1]]
     [,1] [,2]
[1,]    1    1
[2,]    1    1

[[2]]
     [,1] [,2] [,3] [,4]
[1,]    1    1    1    1
[2,]    1    1    1    1
[3,]    1    1    1    1

[[3]]
     [,1] [,2]
[1,]    1    1
[2,]    1    1
[3,]    1    1

[[4]]
     [,1] [,2]
[1,]    1    1
[2,]    1    1
[3,]    1    1

Actualizaciones de código simplificado.

Answer 3

Una respuesta bastante larga, pero puede hacerlo a través del etiquetado de imágenes como hice en esta respuesta SO . Esto se extenderá muy bien a blobs no rectangulares de 1.

find.contiguous <- function(img, x, bg) {
  ## we need to deal with a single (row,col) matrix index
  ## versus a collection of them in a two column matrix separately.
  if (length(x) > 2) {
    lbl <- img[x][1]
    img[x] <- bg
    xc <- x[,1]
    yc <- x[,2]
  } else {
    lbl <- img[x[1],x[2]]
    img[x[1],x[2]] <- bg
    xc <- x[1]
    yc <- x[2]
  }    
  ## find all neighbors of x
  xmin <- ifelse((xc-1) < 1, 1, (xc-1))
  xmax <- ifelse((xc+1) > nrow(img), nrow(img), (xc+1))
  ymin <- ifelse((yc-1) < 1, 1, (yc-1))
  ymax <- ifelse((yc+1) > ncol(img), ncol(img), (yc+1))
  ## find all neighbors of x
  x <- rbind(cbind(xmin, ymin),
             cbind(xc  , ymin),
             cbind(xmax, ymin),
             cbind(xmin, yc),
             cbind(xmax, yc),
             cbind(xmin, ymax),
             cbind(xc  , ymax),
             cbind(xmax, ymax))
  ## that have the same label as the original x
  x <- x[img[x] == lbl,]
  ## if there is none, we stop and return the updated image
  if (length(x)==0) return(img);
  ## otherwise, we call this function recursively
  find.contiguous(img,x,bg)
}

find.contiguous es una función recursiva en la que para cada llamada que recibe:

1. Una copia de trabajo de la imagen img .
2. Una colección de índices de píxeles (matriz) x (fila, col) que pertenecen a un objeto en la imagen img .
3. El valor de fondo bg

find.contiguous luego procede a:

1. Establezca todos los píxeles en x en img al color bg . Esto marca que hemos visitado los píxeles.
2. Encuentre todos los píxeles vecinos de x que tengan la misma etiqueta (valor) que en x . Esto hace crecer la región del mismo objeto. Tenga en cuenta que dado que x no es necesariamente un solo píxel, x crece geométricamente de modo que, de hecho, esta función no se queda atrás.
3. Si no hay más vecinos que pertenecen al mismo objeto, devolvemos la imagen actualizada; de lo contrario, hacemos la llamada recursiva.

A partir de un único píxel que corresponde a un objeto, una llamada a find.contiguous hará crecer la región para incluir todos los píxeles del objeto y devolver una imagen actualizada donde el objeto se sustituye por el fondo. Este proceso puede repetirse en un bucle hasta que no haya más objetos en la imagen, de ahí la capacidad de extraer todas las submatrices de 1.

Con tus datos:

m <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 
                 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 
                 0, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 
                 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 
                 0, 0, 0, 0, 0, 0, 1, 1, 1, 0), .Dim = c(10L, 9L))
## make a copy to img which will be converted to all-zeros in the process 
## as matrices of 1''s are extracted by the process
img <- m
## get all pixel coordinates that are objects
x <- which(img==1, arr.ind=TRUE)
## loop until there are no more pixels that are objects
##the output is in the list out
count <- 0
out <- list()
while (length(x) > 0) {
  ## choose a single (e.g., first) pixel location. This belongs to the current
  ## object that we will grow and remove from the image using find.contiguous
  if (length(x) > 2) {
    x1 <- x[1,]
  }
  ## make the call to remove the object from img
  img <- find.contiguous(img, x1, 0)
  ## find the remaining pixel locations belonging to objects
  xnew <- which(img==1, arr.ind=TRUE)
  count <- count + 1
  ## extract the indices for the 1''s found by diffing new with x 
  out.ind <- x[!(x[,1] %in% xnew[,1] & x[,2] %in% xnew[,2]),]
  ## set it as a matrix in the output
  out[[count]] <- matrix(m[out.ind],nrow=length(unique(out.ind[,1])),ncol=length(unique(out.ind[,2])))
  x <- xnew
}

Su resultado es la lista:

print(out)
##[[1]]
##     [,1] [,2]
##[1,]    1    1
##[2,]    1    1
##
##[[2]]
##     [,1] [,2] [,3] [,4]
##[1,]    1    1    1    1
##[2,]    1    1    1    1
##[3,]    1    1    1    1
##
##[[3]]
##     [,1] [,2]
##[1,]    1    1
##[2,]    1    1
##[3,]    1    1
##
##[[4]]
##     [,1] [,2]
##[1,]    1    1
##[2,]    1    1
##[3,]    1    1

Tenga en cuenta que puede generar fácilmente las ubicaciones de los 1 extraídos de out.ind :