R语言 非方阵的最大团问题

sczxawaw  于 2023-09-27  发布在  其他
关注(0)|答案(3)|浏览(92)

我有很多像这样的非方阵:
我想要一个通用的解决方案,找到这些矩阵中最大的密集连接区域。因此,对于我的示例,解决方案将返回rows=c(1, 2, 3), columns=c(1,2)。也就是说,我可以接受非最优解,即。局部最小值很好。
我认为这与max-clique problem类似。然而,我的矩阵不是正方形,它们不能表示图形,所以我在使用网络工具处理像igraph::cliques()这样的集团时遇到了麻烦。如何找到 * 非正方形 * 矩阵的密集连接区域?
为了澄清“密集区域”,我指的是矩阵中包含所有1的任何矩形块,这可以通过重新排序行和列来实现。所以原始矩阵中的行和列的排序并不重要,我想考虑排序的所有排列。我真的在寻找类似/等价于邻接矩阵中的集团的区域,但是,同样,这些矩阵不是正方形的。

enxuqcxy

enxuqcxy1#

您正在寻找最大的bicliques。igraph还不直接支持这些功能,但您可以在GitHub here上打开功能请求。如果你有,如果你能查一下并引用一些算法来计算它,那就太好了。
现在,我们可以通过将这个非方阵解释为对称方阵的非对角部分,将其简化为标准的团问题。这是你的矩阵:

我们将其转换为:

白色代表0,其他颜色代表1。我使用了两种非白色的颜色来清楚地显示原始矩阵的位置。
原来的行1-4仍然是1-4,原来的列1-3现在是5-7。
我们现在可以寻找同时包含“行顶点”(1-4)和“列顶点”(5-7)的最大团。
要使用igraph实现这一点,您可以:

  • 补矩阵m,取m <- 1 - m
  • 使用graph_from_incidence_matrix(m)得到一个对应于补数的图。
  • 现在你可以寻找独立的顶点集,参见maximal_ivs()。但我记得,这仍然使用了igraph中的低效实现。因此,我建议使用complementer()图并查找max_cliques()

这就是我们得到的:

  • 1, 2, 3, 4, 5,即行1-4和列1
  • 1, 2, 3, 5, 6,即第1-3行和第1-2列(示例解决方案)
  • 4, 5, 7,即行4和列1、3
  • 5, 6, 7,我们扔掉它,因为它只包含**列,没有行。

我将把详细的解决方案留给你,因为我不是一个R程序员。我在Mathematica中使用IGraph/M。
R解决方案的第一步,仍然需要过滤结果:

library(igraph)

m <- matrix(c(1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1), nrow = 4, ncol = 3, byrow = TRUE)
g <- graph_from_incidence_matrix(1 - m)

# one way:
maximal_ivs(g)

# another way, likely faster:
max_cliques(complementer(g))

# we are basically finding cliques in:
1-as_adjacency_matrix(g)
rsaldnfx

rsaldnfx2#

我认为igraph approach by @szabolcs是解决您的问题最有效和简洁的。
下面是另一个老式的解决方案**,只使用基础R**,它既不高效也不简洁,因为使用igraph,但如果你想在不使用外部帮助工具的情况下实现,你可能会在那里找到一些提示。

f <- function(m) {
    idx <- which(m == 1, TRUE)
    res <- list(list(idx = NULL, sz = 0))
    for (k in 1:nrow(idx)) {
        i1 <- idx[k, 1]
        j1 <- idx[k, 2]
        for (i2 in i1:nrow(m)) {
            for (j2 in j1:ncol(m)) {
                if (all(m[i1:i2, j1:j2, drop = FALSE] == 1)) {
                    i <- i1:i2
                    j <- j1:j2
                    l <- length(i) * length(j)
                    maxsz <- max(unlist(lapply(res, `[[`, "sz")))
                    toadd <- list(list(
                        idx = list(i = i1:i2, j = j1:j2),
                        sz = l
                    ))
                    if (l > maxsz) {
                        res <- toadd
                    }
                    if (l == maxsz) {
                        res <- c(res, toadd)
                    }
                }
            }
        }
    }
    res
}

其中res包含最大团的索引(行$idx$i和列$idx$j)和大小($sz)信息,如果有多个(参见输出部分的示例2)。

输出示例

  • 实施例1

给定矩阵m

> m
     [,1] [,2] [,3]
[1,]    1    1    0
[2,]    1    1    0
[3,]    1    1    0
[4,]    1    0    1

我们得到

> f(m)
[[1]]
[[1]]$idx
[[1]]$idx$i
[1] 1 2 3

[[1]]$idx$j
[1] 1 2

[[1]]$sz
[1] 6
  • 实施例2

给定矩阵m

> m
     [,1] [,2] [,3] [,4]
[1,]    1    1    0    0
[2,]    1    1    0    0
[3,]    1    1    1    1
[4,]    0    1    1    1

我们得到

> f(m)
[[1]]
[[1]]$idx
[[1]]$idx$i
[1] 1 2 3

[[1]]$idx$j
[1] 1 2

[[1]]$sz
[1] 6

[[2]]
[[2]]$idx
[[2]]$idx$i
[1] 3 4

[[2]]$idx$j
[1] 2 3 4

[[2]]$sz
[1] 6
icomxhvb

icomxhvb3#

也许这是一个过于简单的方法,但是,

matrix(c(1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1), nrow = 4, ncol = 3, byrow = TRUE)
     [,1] [,2] [,3]
[1,]    1    1    0
[2,]    1    1    0
[3,]    1    1    0
[4,]    1    0    1

which(matrix(c(1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1), nrow = 4, ncol = 3, byrow = TRUE) == 1, arr.ind = TRUE)
     row col
[1,]   1   1
[2,]   2   1
[3,]   3   1
[4,]   4   1
[5,]   1   2
[6,]   2   2
[7,]   3   2
[8,]   4   3

which(matrix(c(1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1), nrow = 4, ncol = 3, byrow = TRUE) == 1, arr.ind = TRUE)[,2]
[1] 1 1 1 1 2 2 2 3

rle(which(matrix(c(1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1), nrow = 4, ncol = 3, byrow = TRUE) == 1, arr.ind = TRUE)[,2])$values
[1] 1 2 3

我们的行列?

matrix(which(matrix(c(1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1), nrow = 4, ncol = 3, byrow = TRUE) == 1, arr.ind = TRUE)[,2],nrow = 4)
     [,1] [,2]
[1,]    1    2
[2,]    1    2
[3,]    1    2
[4,]    1    3

哼,哪一行可以作为列?我不认为这是完全虚假的,但我想应用的方法,以更多的矩阵…受到@szabolcs关于前图论“以示例为例”的评论的鼓舞

matrix(c(0,0,0,1,1,1,1,1,1,0,0,0), nrow = 4, byrow = TRUE)
     [,1] [,2] [,3]
[1,]    0    0    0
[2,]    1    1    1
[3,]    1    1    1
[4,]    0    0    0
rle(which(matrix(c(0,0,0,1,1,1,1,1,1,0,0,0), nrow = 4, byrow = TRUE)==1, arr.ind = TRUE)[,2])$values
[1] 1 2 3
unique(rle(which(matrix(c(0,0,0,1,1,1,1,1,1,0,0,0), nrow = 4, byrow = TRUE)==1, arr.ind = TRUE)[,1])$values)
[1] 2 3

当通过rle(在arr.ind[,2]列上询问时,我们得到行,在arr.ind[,1]上,我们得到列,如果可以接受这种交换,则返回1的密度的索引,这似乎是一个问题,而不是平方矩阵。

相关问题