如何在R中的稀疏矩阵中查找和命名连续的非零项？

我的问题在概念上很简单。 我正在寻找一个计算效率高的解决方案（我自己的一个我附加在最后）

假设我们有一个可能非常大的稀疏矩阵，如下面左侧的矩阵，并希望用单独的代码“命名”每个连续非零元素区域（请参见右侧的矩阵）

在我的应用程序中，相邻元素将形成矩形、直线或单点，它们只能与顶点相互接触（即矩阵中没有不规则/非矩形区域）

我设想的解决方案是将稀疏矩阵表示的行和列索引与具有适当值（名称代码）的向量相匹配。我的解决方案对循环使用了几个

，

，对于中小型矩阵效果很好，但当矩阵的维数变大（>1000）时，会很快卡在循环中。这可能取决于我在R编程方面不是很先进——我找不到任何计算技巧/函数来更好地解决它

有人能提出一种计算效率更高的方法在R中实现这一点吗

我的解决方案：

mySolution <- function(X){

  if (class(X) != "ngCMatrix") {stop("Input must be a Sparse Matrix")}
  ind <- which(X == TRUE, arr.ind = TRUE)
  r <- ind[,1]
  c <- ind[,2]

  lr <- nrow(ind)
  for (i in 1:lr) {
    if(i == 1) {bk <- 1}
    else {
      if (r[i]-r[i-1] == 1){bk <- c(bk, bk[i-1])}
      else {bk <- c(bk, bk[i-1]+1)}
    }
  }

  for (LOOP in 1:(lr-1)) {
    tr <- r[LOOP]
    tc <- c[LOOP]
    for (j in (LOOP+1):lr){
      if (r[j] == tr) {
        if(c[j] == tc + 1) {bk[j] <- bk[LOOP]} 
      }
    }
  }

  val <- unique(bk)
  for (k in 1:lr){
    bk[k] <- which(val==bk[k])
  }

  return(sparseMatrix(i = r, j = c, x = bk))
}

---

mySolution在很大程度上依赖于要分组的所有相邻元素仅形成矩形/直线/点这一事实，我们可以看到矩阵元素可以根据它们在矩阵上的
[row，col]
索引通过关系
（abs（row1-row2）+abs（col1-col2））<2
进行聚合

因此，从
[行，列]
索引开始：

sm = as.matrix(summary(m))

我们计算它们的距离，正如GiuGe所指出的，这实际上是“曼哈顿”方法：

在这里，将元素聚集在最近邻上的单链接特性很有用。此外，我们还可以通过在“h=1”（其中索引的距离为“<2”）上设置剖树来获得元素的分组：

最后，我们可以将上述内容封装在一个新的稀疏矩阵中：

sparseMatrix(i = sm[, "i"], j = sm[, "j"], x = gr)
#8 x 8 sparse Matrix of class "dgCMatrix"
#                    
#[1,] 1 1 1 . . . . .
#[2,] 1 1 1 . 4 4 . .
#[3,] 1 1 1 . 4 4 . .
#[4,] . . . . 4 4 . .
#[5,] . . 3 3 . . 7 7
#[6,] 2 . 3 3 . . 7 7
#[7,] 2 . . . 5 . . .
#[8,] 2 . . . . 6 6 6

使用的“m”是：

编辑2017年2月10日

另一个想法（同样，考虑到相邻元素仅形成矩形/直线/点的事实）是在升序列中通过
[row，col]
索引进行迭代，并在每一步中找到当前列和行中其最近邻元素的距离。如果找到“<2”距离，则该元素与其相邻元素分组，否则将启动一个新组。包装到函数中：

ff = function(x) 
{
    sm = as.matrix(summary(x))

    gr = integer(nrow(sm)); ngr = 0L ; gr[1] = ngr 

    lastSeenRow = integer(nrow(x))
    lastSeenCol = integer(ncol(x))

    for(k in 1:nrow(sm)) {
        kr = sm[k, 1]; kc = sm[k, 2]
        i = lastSeenRow[kr]
        j = lastSeenCol[kc]

        if(i && (abs(kc - sm[i, 2]) == 1)) gr[k] = gr[i]
        else if(j && (abs(kr - sm[j, 1]) == 1)) gr[k] = gr[j]  
             else { ngr = ngr + 1L; gr[k] = ngr } 

        lastSeenRow[kr] = k
        lastSeenCol[kc] = k        
    }

    sparseMatrix(i = sm[, "i"], j = sm[, "j"], x = gr)                 
}                  

并应用于“m”：

此外，两个函数以相同的顺序返回组也很方便，因为我们可以检查：

identical(mySolution(m), ff(m))
#[1] TRUE

在一个看似更复杂的例子中：

mm = new("ngCMatrix"
    , i = c(25L, 26L, 27L, 25L, 29L, 25L, 25L, 17L, 18L, 26L, 3L, 4L, 5L, 
14L, 17L, 18L, 25L, 27L, 3L, 4L, 5L, 17L, 18L, 23L, 26L, 3L, 
4L, 5L, 10L, 17L, 18L, 9L, 11L, 17L, 18L, 10L, 17L, 18L, 3L, 
17L, 18L, 21L, 17L, 18L, 17L, 18L, 1L, 2L, 3L, 4L, 16L, 8L, 17L, 
18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 7L, 9L, 10L, 11L, 26L, 
8L, 27L, 1L, 2L, 28L, 1L, 2L, 15L, 27L, 1L, 2L, 21L, 22L, 1L, 
2L, 7L, 21L, 22L, 1L, 2L, 6L, 24L, 1L, 2L, 5L, 11L, 16L, 25L, 
26L, 27L, 4L, 15L, 17L, 19L, 25L, 26L, 27L, 3L, 16L, 25L, 26L, 
27L, 2L, 28L, 1L)
    , p = c(0L, 0L, 3L, 3L, 5L, 6L, 7L, 7L, 10L, 18L, 25L, 31L, 35L, 38L, 
42L, 44L, 46L, 51L, 61L, 66L, 68L, 71L, 75L, 79L, 84L, 88L, 96L, 
103L, 108L, 110L, 111L)
    , Dim = c(30L, 30L)
    , Dimnames = list(NULL, NULL)
    , factors = list()
)
identical(mySolution(mm), ff(mm))
#[1] TRUE

以及更大矩阵上的简单基准：

times = 30 # times `dim(mm)`
MM2 = do.call(cbind, rep_len(list(do.call(rbind, rep_len(list(mm), times))), times))
dim(MM2)
#[1] 900 900

system.time({ ans1 = mySolution(MM2) })
#   user  system elapsed 
# 449.50    0.53  463.26

system.time({ ans2 = ff(MM2) })
#   user  system elapsed 
#   0.51    0.00    0.52

identical(ans1, ans2)
#[1] TRUE

可能是
Rcpp
的一个很好的用例。您的代码似乎足够简单，可以translate@apom你可能是对的，但我现在正在浏览
Rcpp
小故事，如果我需要了解
C++
语言，很遗憾，这不适合我……假设
m
是你的“ngCMatrix”，您可以尝试找到一种方法来制作类似于
sm=summary（m）；sparseMatrix（i=sm$i，j=sm$j，x=cutree（hclust（dist（sm，“max”）），h=2））
workappropriately@alexis_laz，我印象深刻-如此优雅。起首，我永远不会找到这样的解决办法。我正在运行一些模拟，但它似乎有效。谢谢你的启示。：）@朱格：我知道；找不到办法让它工作。同样，考虑到“仅矩形”条件，并计算自定义距离
sm=as.matrix（总结（m））；d=as.dist（sapply（1:nrow（sm），function（i）rowSums（abs（sm[i，col（sm）]-sm））
，使用
sparseMatrix（i=sm[，“i”]，j=sm[，“j”]，x=cutree（hclust（d，“single”），h=1））
对于当前的示例来说似乎效果不错，尽管我倾向于相信会有很多情况打破它。谢谢@alexis\u laz。过去几天我一直在尝试这个代码。结果是正确的，并且比我的解决方案更快。然而，对于Veeery大矩阵（>1000x1000），在构建距离矩阵时仍然会阻塞RAM。所以新方法也很受欢迎。@GiuGe:是的，虽然“dist”不能保存整个距离矩阵，但它的
更低。tri
，它仍然需要大量内存。我添加了另一种方法，在某些情况下对其进行测试，似乎是正确的；希望在这个过程中我没有错过什么。太棒了@亚历克西斯，你是个天才！非常感谢你。
ff = function(x) 
{
    sm = as.matrix(summary(x))

    gr = integer(nrow(sm)); ngr = 0L ; gr[1] = ngr 

    lastSeenRow = integer(nrow(x))
    lastSeenCol = integer(ncol(x))

    for(k in 1:nrow(sm)) {
        kr = sm[k, 1]; kc = sm[k, 2]
        i = lastSeenRow[kr]
        j = lastSeenCol[kc]

        if(i && (abs(kc - sm[i, 2]) == 1)) gr[k] = gr[i]
        else if(j && (abs(kr - sm[j, 1]) == 1)) gr[k] = gr[j]  
             else { ngr = ngr + 1L; gr[k] = ngr } 

        lastSeenRow[kr] = k
        lastSeenCol[kc] = k        
    }

    sparseMatrix(i = sm[, "i"], j = sm[, "j"], x = gr)                 
}                  

ff(m)
#8 x 8 sparse Matrix of class "dgCMatrix"
#                    
#[1,] 1 1 1 . . . . .
#[2,] 1 1 1 . 4 4 . .
#[3,] 1 1 1 . 4 4 . .
#[4,] . . . . 4 4 . .
#[5,] . . 3 3 . . 7 7
#[6,] 2 . 3 3 . . 7 7
#[7,] 2 . . . 5 . . .
#[8,] 2 . . . . 6 6 6

identical(mySolution(m), ff(m))
#[1] TRUE

mm = new("ngCMatrix"
    , i = c(25L, 26L, 27L, 25L, 29L, 25L, 25L, 17L, 18L, 26L, 3L, 4L, 5L, 
14L, 17L, 18L, 25L, 27L, 3L, 4L, 5L, 17L, 18L, 23L, 26L, 3L, 
4L, 5L, 10L, 17L, 18L, 9L, 11L, 17L, 18L, 10L, 17L, 18L, 3L, 
17L, 18L, 21L, 17L, 18L, 17L, 18L, 1L, 2L, 3L, 4L, 16L, 8L, 17L, 
18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 7L, 9L, 10L, 11L, 26L, 
8L, 27L, 1L, 2L, 28L, 1L, 2L, 15L, 27L, 1L, 2L, 21L, 22L, 1L, 
2L, 7L, 21L, 22L, 1L, 2L, 6L, 24L, 1L, 2L, 5L, 11L, 16L, 25L, 
26L, 27L, 4L, 15L, 17L, 19L, 25L, 26L, 27L, 3L, 16L, 25L, 26L, 
27L, 2L, 28L, 1L)
    , p = c(0L, 0L, 3L, 3L, 5L, 6L, 7L, 7L, 10L, 18L, 25L, 31L, 35L, 38L, 
42L, 44L, 46L, 51L, 61L, 66L, 68L, 71L, 75L, 79L, 84L, 88L, 96L, 
103L, 108L, 110L, 111L)
    , Dim = c(30L, 30L)
    , Dimnames = list(NULL, NULL)
    , factors = list()
)
identical(mySolution(mm), ff(mm))
#[1] TRUE

times = 30 # times `dim(mm)`
MM2 = do.call(cbind, rep_len(list(do.call(rbind, rep_len(list(mm), times))), times))
dim(MM2)
#[1] 900 900

system.time({ ans1 = mySolution(MM2) })
#   user  system elapsed 
# 449.50    0.53  463.26

system.time({ ans2 = ff(MM2) })
#   user  system elapsed 
#   0.51    0.00    0.52

identical(ans1, ans2)
#[1] TRUE