识别被矩阵中的一包围的零区域

Question

我有一个二进制矩阵列表。在每个矩阵中，我想检测被连接的黑色像素 (1) 环（链）包围的白色像素区域 (0)。

例如，在下面的矩阵中，有两个白色像素（零）区域都完全被连接 1 的“链”包围：2x2 和 3x2 0 组。

m
#         [,1] [,2] [,3] [,4] [,5] [,6] [,7]
#    [1,]    1    1    1    1    0    0    1
# -> [2,]    1    0    0    1    1    1    1
# -> [3,]    1    0    0    1    0    0    1 <- 
#    [4,]    1    1    1    1    0    0    1 <- 
#    [5,]    1    0    0    1    0    0    1 <-
#    [6,]    0    1    1    1    1    1    1

m <- matrix(c(1, 1, 1, 1, 0, 0, 1,
              1, 0, 0, 1, 1, 1, 1,
              1, 0, 0, 1, 0, 0, 1,
              1, 1, 1, 1, 0, 0, 1,
              1, 0, 0, 1, 0, 0, 1,
              0, 1, 1, 1, 1, 1, 1),
            byrow = TRUE, nrow = 6)

---

list 中包含三个二进制矩阵的示例：

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

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

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

mat_list <- list(x, y, z)

我曾想过在raster 包中使用boundaries 函数，所以我首先将矩阵转换为栅格：

library(igraph)
library(raster)

lapply(list, function (list) {
  Rastermat <- raster(list)
})

---

任何关于我如何实现这一点的指导将不胜感激。

---

Answer 1

修订答案以获取新信息。

对于这个答案，连接像素的定义比用于图像处理的定义要多一些。在这里，如果像素以{x,y} 和{x+1,y} 或{x,y} 和{x,y+1} 共享一侧，或者以{x,y} 和{x+1,y+1} 触摸角落，则认为它们已连接。其他包（例如 igraph）可能更有效地完成此任务，但 EBImage 可以使用工具来完成这项工作，以可视化或进一步处理结果。

EBImage 包中的bwlabel 函数在这里用于查找连接的像素组。正如作者所描述的那样：

bwlabel 查找除背景之外的所有连接像素集， 并用唯一的递增整数重新标记这些集合

这是 Bioconductor 软件包 EBImage 的一部分，它是 R 的图像处理和分析工具箱。它有点大。以下代码检查可用性并在需要时尝试下载和安装包：

# EBImage needed through Bioconductor, which uses BiocManager
  if (!require(EBImage)) {
    if (!requireNamespace("BiocManager", quietly = TRUE))
      install.packages("BiocManager")
    BiocManager::install("EBImage")
    require(EBImage)
  }

EBImage 工具允许您从二值图像（考虑的对象）中提取连接的像素，并对它们进行量化或可视化。对于任何矫枉过正的行为表示歉意，这里有一个REPLACED答案，其中包含一个更广泛的示例，其中包括不规则对象来演示解决方案。

通常，0 用于图像处理中没有数据，因此示例中的数据使用 0 表示非数据，1 表示数据。

# Sample data with 1 as data, 0 as non-data
dat <- c(0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,1,1,
         0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,1,1,
         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
         0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,1,1,
         0,0,1,1,1,1,0,0,1,1,1,1,1,1,1,0,0,0,1,1,
         0,0,1,1,1,1,0,0,1,1,1,1,1,1,1,0,0,0,0,0,
         0,0,1,1,0,0,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,0,0,0,0,0,0,0,0,
         0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
         0,0,1,1,0,0,1,1,0,0,0,1,1,1,0,0,0,0,0,0,
         0,0,1,1,1,1,1,1,0,0,0,1,1,1,0,0,1,1,1,0,
         0,0,1,1,1,1,1,1,0,0,0,1,1,1,0,0,1,0,1,0,
         0,0,1,1,1,1,1,1,0,0,0,1,1,1,0,0,1,1,1,0,
         0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,
         0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,
         0,1,1,0,0,0,0,0,0,1,1,0,0,0,1,1,1,0,0,0,
         0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
         0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
         0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,
         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
# convert to 20x20 pixel image object
  x <- Image(dat, dim = c(20, 20)) # use 1 for data, 0 for non-data
# plotting with base graphics allows the use of other R tools
  plot(x, interp = FALSE) # interpolate = FALSE option preserves pixels

dat 中 20 x 20 二进制数组的图像表示。

# bwlabel() extracts connected pixels from a binary image
# and labels the connected objects in a new Image object
  xm <- bwlabel(x)
  xm # show the first 5 rows, first 6 columns of "objects" identified by bwlabel
> Image 
>   colorMode    : Grayscale 
>   storage.mode : integer 
>   dim          : 20 20 
>   frames.total : 1 
>   frames.render: 1 
> 
> imageData(object)[1:5,1:6]
>      [,1] [,2] [,3] [,4] [,5] [,6]
> [1,]    0    0    0    0    0    0
> [2,]    0    0    0    0    0    0
> [3,]    0    0    0    0    4    4
> [4,]    1    1    0    0    4    4
> [5,]    1    1    0    0    4    4

找到的对象（连接像素）的数量只是bwlabel 返回的对象中的最大值。通过table 函数可以轻松获得每个对象（连接像素）的大小。可以提取此信息并用于准备标记图像。此示例包括一个带孔的对象。

# total number of objects found
  max(xm) 
> 9

# size of each object (leaving out background or value = 0 pixels)
  table(xm[xm > 0])
>  1  2  3  4  5  6  7  8  9 
>  8 13 21 36 15  8  4  6 21 

# plot results with labels
  iy <- (seq_along(x) - 1) %/% dim(x)[1] + 1
  ix <- (seq_along(x) - 1) %% dim(x)[1] + 1

  plot(xm, interp = FALSE)
  text(ix, iy, ifelse(xm==0, "", xm)) # label each pixel with object group

有五个对象被连接的背景像素“链”包围：#3、#4、#6、#7 和#9。对象 #6 包括在内，即使它有一个洞。可以调整逻辑以排除有孔的对象。对象#1 和#2 将被排除，因为它们与边缘接壤。对象#5 和#8 将被排除在外，因为它们接触到一个角落。如果这准确地代表了任务，EBImage 仍然可以帮助解决下面列举的逻辑。简而言之，如果它只覆盖原始图像中的空白（或非边框）像素，则会创建并确定每个对象周围的边框。

1. 将bwlabel 找到的每个对象提取为单独的图像 (xobj)
2. 为xobj 中的每个对象添加黑色（零）像素边框
3. 使用EBImage::dilate (xdil) 将xobj 中的每个对象放大一个像素
4. 使用xor (xmask) 创建差异蒙版
5. 为原始图像添加非零边框 (x2)
6. 结合 xmask 和 x2 来识别具有非空白像素的边框
7. 删除上面标识的对象

# Extract each object found by bwlabel() as a separate image
  xobj <- lapply(seq_len(max(xm)), function(i) xm == i)

# Add a border of black (zero) pixels to each object in `xobj`
  xobj <- lapply(xobj, function(v) cbind(0, rbind(0, v, 0), 0))
  xobj <- lapply(xobj, as.Image)
  xobj <- combine(xobj) # combine as multi-dimensional array

# Dilate each object in `xobj` by one pixel
  br <- makeBrush(3, shape = "box") # 3 x 3 structuring element
  xdil <- dilate(xobj, br)

# Create difference mask with xor()
  xmask <- xor(xdil, xobj) # difference is the border

# Add a non-zero border to the original image
  x2 <- Image(cbind(1, rbind(1, x, 1), 1))

# Identify borders that have non-blank pixels
  target <- Image(x2, dim = dim(xmask)) # replicate x2
  sel <- which(apply(xmask & target, 3, any) == TRUE)

# Remove objects identified above (keeping original numbers)
  found <- rmObjects(xm, sel, reenumerate = FALSE)

# Show the found objects
  table(found[found > 0])
>  3  4  6  7  9 
> 21 36  8  4 21 

可以通过绘图检查每个对象。可以用plot(xobj, all = TRUE, interp = FALSE)绘制xobj、xdil、xmask等多维图像，查看中间结果。在这里，过滤（找到）的对象是 用原始对象编号重新绘制

  plot(found, interp = FALSE)
  text(ix, iy, ifelse(found==0, "", found)) # label each pixel group no.

要了解有关 EBImage 的更多信息，请参阅包 vignette。