Question

说二进制矩阵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))

我们如何提取那些1 - 值的子矩阵？ e.g。

m[7:9,8:9]

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

关键是我想在算法上提取它们而不是像m[7:9,8:9]那样明确地对它们进行索引。

输入是二进制矩阵
作为输出的子矩阵列表（因此列出了四个矩阵3*4，2*2，3*2和3*2
子矩阵为1 - 值矩形
子矩阵的边界用零保护。

Answer 1

我将它视为一个空间问题，你有一个光栅，想要检测已连接单元格的区域。

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

在栅格包中使用focal，并使用适当的加权矩阵w。它。将w与m合并为一个矩阵，其尺寸与m相同，每个左上角的值为big，其他值则为其他值，因此将其与{{1}进行比较给出一个逻辑矩阵，在矩形的左上角为TRUE。使用big我们得到which，每个矩形有一行，两列代表该矩形左上角的i和j坐标。 rc调用遍历左上角坐标，在每个坐标上调用Map。 genmap使用genmap（在rle函数中定义）查找每个坐标方向上1的运行长度，并返回具有这些维度的矩阵。

rl

，并提供：

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])

更新简化代码。

Answer 3

一个相当冗长的答案，但你可以像我在SO answer那样通过图像标记来做到这一点。这将很好地扩展到1的非矩形blob。

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是一个递归函数，对于它接收的每个调用：

图片img的工作副本。
属于图像x中对象的像素（矩阵）索引img（row，col）的集合。
背景值bg

find.contiguous然后进入：

将x中的img处的所有像素设置为bg颜色。这标志着我们访问了像素。
查找x中与x具有相同标签（值）的所有相邻像素。这会增加同一对象的区域。请注意，由于x不一定是单个像素，x几何增长，因此，事实上，此功能并不懈怠。
如果没有更多邻居属于同一个对象，我们会返回更新后的图像;否则，我们进行递归调用。

从对应于对象的单个像素开始，对find.contiguous的调用将使区域增大以包括所有对象的像素，并返回更新的图像，其中对象被背景替换。然后可以循环重复此过程，直到图像中不再有对象为止，因此能够提取1的所有子矩阵。

使用您的数据：

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
}

您的输出是列表out：

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

请注意，您可以轻松地从out.ind输出提取的1的位置：

从R中的二进制矩阵中提取子矩阵

3 个答案: