过滤逻辑和对称矩阵答案

【问题标题】：Filtering a logical and symmetric matrix过滤逻辑和对称矩阵
【发布时间】：2021-09-24 15:33:55
【问题描述】：

我有一个逻辑对称矩阵，我想根据我在对角线上的值创建块。这是我的矩阵：

MAT <- data.frame(matrix(data = c(rep(TRUE, 9), rep(FALSE, 3), rep(TRUE, 3), FALSE, rep(TRUE, 3), rep(FALSE, 2), TRUE, 
                FALSE, rep(TRUE, 2), FALSE, TRUE, FALSE, rep(TRUE, 3), FALSE, rep(TRUE, 4)), 6))

 [,1]  [,2]  [,3]  [,4]  [,5]  [,6]
[1,] TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
[2,] TRUE  TRUE  TRUE FALSE FALSE FALSE
[3,] TRUE  TRUE  TRUE FALSE  TRUE  TRUE
[4,] TRUE FALSE FALSE  TRUE FALSE  TRUE
[5,] TRUE FALSE  TRUE FALSE  TRUE  TRUE
[6,] TRUE FALSE  TRUE  TRUE  TRUE  TRUE

这是所需的矩阵：我们可以看到一个块是基于 TRUE 值的。所有列和行必须通过 TRUE 相互关联才能成为块。一旦我们有一个 FALSE，就没有阻塞。就像第四列一样，我们可以有一个仅由一列组成的块。

我的目标是在属于一个块的每一列中放入相同的数字，如图所示。

【问题讨论】：

我把颜色只是为了说明块。我只想在属于一个块的每一列中放置相同的数字（如图所示）。我无法手动执行此操作，因为我有数千列
我理解那部分，但不清楚您对输出的期望。被退回。您需要矩阵等列表
我想在同一个矩阵的顶部创建行。该行应包含图像中的块编号。

标签： r matrix filtering

【解决方案1】：

问题指出 MAT 是一个矩阵，但实际上，它在那里被定义为一个 data.frame。这很重要，因为all(MAT) 问题中定义的 MAT 在 R 4.0 中会出现错误，但在 R 4.1 中不会出现错误，因此请确保您将 R 4.1 与以下代码一起使用。交替使用 MAT <- as.matrix(MAT) 将 MAT 转换为矩阵，在这种情况下，下面的代码适用于 4.1 和 4.0 及更早版本。

1) 循环 is.complete(i, j) 如果 MAT[i:j, i:j] 中的所有单元格都为 TRUE，则为 TRUE。如果 p 到 i 完整且 p 到 i+1 不完整，则 p 到 i 是一个块，因此将 i 记录在 d 中，然后在最后找到每个块的长度并使用 rep 创建所需的向量，将其放置在列名，因为不能将逻辑值和整数值混合在一起。

is.complete <- function(i, j) all(MAT[i:j, i:j])

i <- p <- 1
d <- c()
for(i in 1:nrow(MAT)) {
  ok <- is.complete(p, i) && (i == nrow(MAT) || !is.complete(p, i+1) )
  if (ok) { p <- i+1; d <- c(d, i) }
}
colnames(MAT) <- rep(seq_along(d), diff(c(0, d)))
MAT

给予：

     1     1     1     2     3     3
1 TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
2 TRUE  TRUE  TRUE FALSE FALSE FALSE
3 TRUE  TRUE  TRUE FALSE  TRUE  TRUE
4 TRUE FALSE FALSE  TRUE FALSE  TRUE
5 TRUE FALSE  TRUE FALSE  TRUE  TRUE
6 TRUE FALSE  TRUE  TRUE  TRUE  TRUE

2) Reduce 另一种可能性是Reduce。我们累积块的当前开始，p。在每一步，我们都考虑下一个索引 i，如果从 p 到 i 的块完全为真，那么我们继续 p 继续考虑；否则我们在 i 处开始一个新块。最后，Reduce 返回为块的每一行（或列）重复的块开始的向量。然后我们可以转换为因子并取整数级别得到 1, 2, ... 这种方法很紧凑并且不使用显式循环。

f <- function(p, i) if (all(MAT[p:i, p:i])) p else i
colnames(MAT) <- as.integer(factor(Reduce(f, 1:nrow(MAT), acc = TRUE)))
MAT

给予：

     1     1     1     2     3     3
1 TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
2 TRUE  TRUE  TRUE FALSE FALSE FALSE
3 TRUE  TRUE  TRUE FALSE  TRUE  TRUE
4 TRUE FALSE FALSE  TRUE FALSE  TRUE
5 TRUE FALSE  TRUE FALSE  TRUE  TRUE
6 TRUE FALSE  TRUE  TRUE  TRUE  TRUE

3) 最大化块中的单元格 目前的解决方案本质上是贪婪的。他们占据最大的块，当找不到更大的块时，开始一个新的块；但是，如果希望最大化块中的单元格数量，则可能不会给出最大值。

如果我们将 MAT 视为邻接矩阵，我们可以将其转换为图，在这种情况下，块对应于完整的子图，也称为团。我们生成所有派系并形成一个 nrow(MAT) 行矩阵 K，每列一个派系，这样每一列都是一个 0/1 向量，指示 MAT 中的哪些行在该派系中。如果有该矩阵中的 p 列然后我们形成一个目标 p 向量 v 使得 v[i] 等于 sum(K[, i])^2，即块中对应于 clique i 的单元数。由此我们形成整数线性规划，通过选择满足以下条件的 0/1 向量来最大化块中的单元数：

max v'x such that Kx = 1 
x is 0/1 vector

其中 1 是 nrow(K) 个向量。这称为集合分区问题。

library(igraph)
cli <- cliques(graph_from_adjacency_matrix(as.matrix(MAT), mode = "undirected"))
K <- +sapply(cli, function(x) colnames(MAT) %in% names(x))

library(lpSolve)
obj <- colSums(K)^2
res <- lp("max", obj, K, "=", 1, all.bin = TRUE)
Ksoln <- K[, res$solution == 1]
o <- order(apply(Ksoln, 2, which.max))
colnames(MAT) <- Ksoln[, o] %*% 1:ncol(Ksoln)
MAT

给予：

     1     2     1     3     1     1
1 TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
2 TRUE  TRUE  TRUE FALSE FALSE FALSE
3 TRUE  TRUE  TRUE FALSE  TRUE  TRUE
4 TRUE FALSE FALSE  TRUE FALSE  TRUE
5 TRUE FALSE  TRUE FALSE  TRUE  TRUE
6 TRUE FALSE  TRUE  TRUE  TRUE  TRUE

或按块排序：

o <- order(as.numeric(colnames(MAT)))
MAT2 <- as.matrix(MAT)[o, o]
colnames(MAT2) <- sub("\\.*", "", colnames(MAT2))
MAT2

给出这个重新排序的矩阵：

        1     1     1     1     2     3
[1,] TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
[2,] TRUE  TRUE  TRUE  TRUE  TRUE FALSE
[3,] TRUE  TRUE  TRUE  TRUE FALSE FALSE
[4,] TRUE  TRUE  TRUE  TRUE FALSE  TRUE
[5,] TRUE  TRUE FALSE FALSE  TRUE FALSE
[6,] TRUE FALSE FALSE  TRUE FALSE  TRUE

我们看到这个解决方案有 18 个单元格

res$objval
## [1] 18

而对于贪心解决方案，块中只有 3^2 + 1^2 + 2^2 = 14 个单元格。

4) 在 cmets 中，发帖人表示他们对 (3) 的变体感兴趣，其中组被限制为连续的。为此，只需将 K 矩阵限制为代表连续组的那些列，即添加涉及 is.consec 的两行代码，下面用 ## 标记。我们还使用了发布者在下面的 cmets 中定义的修改后的输入，并且还用## 标记了这些行。该代码在其他方面与 (3) 相同。

MAT <- data.frame(matrix(data = c(rep(TRUE, 9), rep(FALSE, 3), 
  rep(TRUE, 3), FALSE, rep(TRUE, 3), rep(FALSE, 2), TRUE, 
  FALSE, rep(TRUE, 2), FALSE, TRUE, FALSE, rep(TRUE, 3), FALSE, 
  rep(TRUE, 4)), 6))
MAT<-cbind(MAT,c(TRUE,FALSE,rep(TRUE,2),FALSE,TRUE)) ##
MAT<-rbind(MAT,c(TRUE,FALSE,rep(TRUE,2),FALSE,rep(TRUE,2))) ##
MAT<-cbind(MAT,c(rep(FALSE,5),rep(TRUE,2))) ##
MAT<-rbind(MAT,c(rep(FALSE,5),rep(TRUE,3))) ##

library(igraph)
cli <- cliques(graph_from_adjacency_matrix(as.matrix(MAT), mode = "undirected"))
K <- +sapply(cli, function(x) colnames(MAT) %in% names(x))
 
is.consec <- function(x) sum(x == 1) == 1 ||  all(diff(which(x == 1)) == 1) ##
K <- K[, apply(K, 2, is.consec)] ##
 
library(lpSolve)
obj <- colSums(K)^2
res <- lp("max", obj, K, "=", 1, all.bin = TRUE)
Ksoln <- K[, res$solution == 1]
o <- order(apply(Ksoln, 2, which.max))
colnames(MAT) <- Ksoln[, o] %*% 1:ncol(Ksoln)
MAT

给予：

      1     1     1     2     3     4     4     4
1  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE
2  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE
3  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE FALSE
4  TRUE FALSE FALSE  TRUE FALSE  TRUE  TRUE FALSE
5  TRUE FALSE  TRUE FALSE  TRUE  TRUE FALSE FALSE
6  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
7  TRUE FALSE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE
8 FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE

【讨论】：

精湛的Reduce 方法，为这个惊人的解决方案投票！
两种解决方案都运行良好，谢谢@G。格洛腾迪克。你说的对;就这个问题而言，甚至没有必要像我在问题中那样添加data.frame()。事实上，我只需要删除 data.frame() 并实际使用矩阵来使其工作。这是我最终使用的：MAT <- matrix(data = c(rep(TRUE, 9), rep(FALSE, 3), rep(TRUE, 3), FALSE, rep(TRUE, 3), rep(FALSE, 2), TRUE, FALSE, rep(TRUE, 2), FALSE, TRUE, FALSE, rep(TRUE, 3), FALSE, rep(TRUE, 4)), 6)
添加解决方案（3）。
解决方案 3 并没有真正适应我的情况。无论@G末尾的单元格数量如何，我都希望块连续且完全按照它们在矩阵中出现的顺序排列。格洛腾迪克
已添加 (4) 以解决此问题的变化。

【解决方案2】：

你可以试试下面的代码

mat <- MAT <- as.matrix(MAT)
r <- 0
while (length(mat) != 0) {
    k <- max(which(sapply(seq_along(diag(mat)), function(k) all(mat[1:k, 1:k]))))
    r <- c(r, rep(tail(r,1) + 1, k))
    mat <- as.matrix(mat[-(1:k), ][, -(1:k)])
}
colnames(MAT) <- tail(r, -1)

给了

> MAT
        1     1     1     2     3     3
[1,] TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
[2,] TRUE  TRUE  TRUE FALSE FALSE FALSE
[3,] TRUE  TRUE  TRUE FALSE  TRUE  TRUE
[4,] TRUE FALSE FALSE  TRUE FALSE  TRUE
[5,] TRUE FALSE  TRUE FALSE  TRUE  TRUE
[6,] TRUE FALSE  TRUE  TRUE  TRUE  TRUE

【讨论】：