从R中的二元矩阵中提取子矩阵

说二进制矩阵

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

关键是我想从算法上提取它们，而不是像

m[7:9,8:9]

那样显式地索引它们

• 输入是一个二进制矩阵
• 作为输出的子矩阵列表（因此dim

  3*4

  、

  2*2

  、

  3*2

  和

  3*2

  的四个矩阵列表）
• 子矩阵是

  1

  值的矩形矩阵
• 子矩阵的边界用零保护

---

这是一个相当冗长的答案，但你可以像我在本文中所做的那样，通过图像标签来实现这一点。这将很好地扩展到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)
}

您的输出是列表

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

：

使用光栅包中的

focal

和适当的加权矩阵

w

输出提取的1的位置。信息技术将

w

与

m

进行卷积，得到与

m

尺寸相同的矩阵，每个左上角的值为

big

，其他位置的值为

big

，因此将其与

big

进行比较，可以得到在矩形左上角为真的逻辑矩阵。使用

which

我们得到

rc

，它每个矩形有一行，两列代表该矩形左上角的i和j坐标。

Map

调用在左上角的坐标上迭代，在每个坐标上调用

genmap

genmap

使用

rle

（在

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

---

更新简化代码。

我将其视为一个空间问题，您有一个光栅，希望检测连接单元的区域

library(raster)
r <- raster(m)

library(igraph)
rc <- clump(r)

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

库（光栅）
r你似乎自己找到了答案……你想要的输入和输出是什么样的？你想找到所有只包含1的子矩阵吗？@KonradRudolph输入一个二进制矩阵，输出一个
1
值子矩阵列表。我不想显式地索引它们，而是通过算法提取它们。换句话说，对于您的示例，输出将是四个矩阵的列表？为了避免混淆，我会说子矩阵的内部边界由零保护。这些子矩阵并非完全被零包围。
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])

[[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

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