识别矩阵中被 1 包围的 0 区域
Identify regions of zeros that are surrounded by ones in a matrix
我有一个二进制矩阵列表。在每个矩阵中，我想检测被连接的黑色像素（1）环（链）包围的白色像素（0）区域。
例如，在下面的矩阵中，有两个白色像素（零）区域都完全被 "chain" 个相连的 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)
})
任何关于我如何实现它的指导都将不胜感激。
修订后的答案 以获取新信息。
对于这个答案，连接像素的定义比用于图像处理的要多一些。在这里，如果像素共享一条边作为 {x,y} 和 {x+1,y} 或 {x,y} 和 {x,y+1} 或者在一个角处接触作为 {x,y} 和 {x+1,y+1}.其他包（例如 igraph）可能对这项任务更有效，但 EBImage 可以使用工具来完成这项工作，以可视化或进一步处理结果。
包EBImage中的bwlabel函数在这里用于查找连接的像素组。正如作者所描述的那样：
bwlabel finds every connected set of pixels other than the background,
and relabels these sets with a unique increasing integer
这是 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
有五个对象被 "chain" 个相连的背景像素包围：#3、#4、#6、#7 和 #9。对象 #6 包含在内，即使它有一个洞。可以调整逻辑以排除有孔的对象。对象 #1 和 #2 将被排除在外，因为它们与边缘接壤。对象#5 和#8 将被排除在外，因为它们在一个角处接触。如果这准确地代表了任务，EBImage 仍然可以帮助理解下面列举的逻辑。简而言之，将创建并确定每个对象周围的边框是否仅覆盖原始图像中的空白（或非边框）像素。
- 将
bwlabel 找到的每个对象提取为单独的图像 (xobj)
- 为
xobj 中的每个对象添加黑色（零）像素边框
- 使用
EBImage::dilate (xdil) 将 xobj 中的每个对象扩大一个像素
- 使用
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、xmask等多维图像可以用plot(xobj, all = TRUE, interp = FALSE)绘制，看中间结果。在这里，过滤（找到）的对象是
用原始对象编号重新绘制
plot(found, interp = FALSE)
text(ix, iy, ifelse(found==0, "", found)) # label each pixel group no.
要了解有关 EBImage 的更多信息，请参阅包 vignette。
我有一个二进制矩阵列表。在每个矩阵中，我想检测被连接的黑色像素（1）环（链）包围的白色像素（0）区域。
例如，在下面的矩阵中，有两个白色像素（零）区域都完全被 "chain" 个相连的 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)
})
任何关于我如何实现它的指导都将不胜感激。
修订后的答案 以获取新信息。
对于这个答案，连接像素的定义比用于图像处理的要多一些。在这里，如果像素共享一条边作为 {x,y} 和 {x+1,y} 或 {x,y} 和 {x,y+1} 或者在一个角处接触作为 {x,y} 和 {x+1,y+1}.其他包（例如 igraph）可能对这项任务更有效，但 EBImage 可以使用工具来完成这项工作，以可视化或进一步处理结果。
包EBImage中的bwlabel函数在这里用于查找连接的像素组。正如作者所描述的那样：
bwlabelfinds every connected set of pixels other than the background, and relabels these sets with a unique increasing integer
这是 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.
# 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
有五个对象被 "chain" 个相连的背景像素包围：#3、#4、#6、#7 和 #9。对象 #6 包含在内，即使它有一个洞。可以调整逻辑以排除有孔的对象。对象 #1 和 #2 将被排除在外，因为它们与边缘接壤。对象#5 和#8 将被排除在外，因为它们在一个角处接触。如果这准确地代表了任务，EBImage 仍然可以帮助理解下面列举的逻辑。简而言之，将创建并确定每个对象周围的边框是否仅覆盖原始图像中的空白（或非边框）像素。
- 将
bwlabel找到的每个对象提取为单独的图像 (xobj) - 为
xobj 中的每个对象添加黑色（零）像素边框
- 使用
EBImage::dilate(xdil) 将 - 使用
xor创建差异遮罩 (xmask) - 为原始图像添加非零边框 (
x2) - 合并
xmask和x2以识别具有非空白像素的边框 - 删除上面标识的对象
xobj 中的每个对象扩大一个像素
# 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、xmask等多维图像可以用plot(xobj, all = TRUE, interp = FALSE)绘制，看中间结果。在这里，过滤（找到）的对象是
用原始对象编号重新绘制
plot(found, interp = FALSE)
text(ix, iy, ifelse(found==0, "", found)) # label each pixel group no.
要了解有关 EBImage 的更多信息，请参阅包 vignette。