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

问题描述

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

例如，在下面的矩阵中，有两个白色像素（零）区域都完全被连接 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)

在 a 中包含三个二进制矩阵的示例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)

我已经考虑过使用包boundaries中的函数raster，所以我首先将矩阵转换为栅格：

library(igraph)
library(raster)

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

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

标签： rmatrixpixelrasterr-raster

解决方案

新信息的修订答案。

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

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

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工具允许您从二进制图像（考虑的对象）中提取连接的像素，并对它们进行量化或可视化。对任何矫枉过正的行为表示歉意，这是一个替换答案，其中包含一个更广泛的示例，其中包括不规则对象来演示解决方案。

通常，在图像处理中使用 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

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

# 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仍然可以帮助下面列举的逻辑。简而言之，将创建并确定每个对象周围的边框是否仅覆盖原始图像中的空白（或非边框）像素。

将找到的每个对象提取bwlabel为单独的图像 ( xobj)
为每个对象添加黑色（零）像素边框xobj
用( )将每个对象放大xobj一个像素EBImage::dilatexdil
xor使用( xmask)创建差异蒙版
为原始图像添加非零边框 ( x2)
合并xmask并x2识别具有非空白像素的边框
删除上面标识的对象

# 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

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

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

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

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

问题描述

解决方案

推荐阅读