我的问题在概念上很简单。我正在寻找一个计算效率高的解决方案(我自己的一个,我附在最后)。
假设我们有一个可能非常大的稀疏矩阵,如下面左边的一个,并且希望用一个单独的代码“命名”每一个连续的非零元素(参见右边的矩阵)。
1 1 1 . . . . .          1 1 1 . . . . .
1 1 1 . 1 1 . .          1 1 1 . 4 4 . .
1 1 1 . 1 1 . .          1 1 1 . 4 4 . .
. . . . 1 1 . .   --->   . . . . 4 4 . .
. . 1 1 . . 1 1          . . 3 3 . . 7 7
1 . 1 1 . . 1 1          2 . 3 3 . . 7 7
1 . . . 1 . . .          2 . . . 5 . . .
1 . . . . 1 1 1          2 . . . . 6 6 6在我的应用中,相邻元素将形成矩形、直线或单点,它们只能与顶点相互接触(即矩阵中不存在不规则/非矩形区域)。
我设想的解决方案是将稀疏矩阵表示的行和列索引与适当的值(“名称”代码)匹配到向量。我的解决方案使用了几个for loops,可以很好地处理中小型矩阵,但是当矩阵的维数变大(>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))
}提前感谢您的帮助或指示。
发布于 2017-02-08 17:58:04
在很大程度上依赖于所有相邻元素只形成矩形/直线/点的事实,我们发现矩阵的元素可以根据矩阵上的[row, col]指数通过关系(abs(row1 - row2) + abs(col1 - col2)) < 2进行聚类。
因此,从[row, col]索引开始:
sm = as.matrix(summary(m))我们计算它们的距离,GiuGe注意到,这实际上是“曼哈顿”方法:
d = dist(sm, "manhattan")在最近的邻域上聚类元素的单链特性在这里是有用的。此外,我们还可以通过在"h = 1“(其中索引的距离为"< 2”)上进行cutreeing来获得元素的分组:
gr = cutree(hclust(d, "single"), h = 1)最后,我们可以将上面的内容封装在一个新的稀疏矩阵中:
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“是:
library(Matrix)
m = new("ngCMatrix"
    , i = c(0L, 1L, 2L, 5L, 6L, 7L, 0L, 1L, 2L, 0L, 1L, 2L, 4L, 5L, 4L, 
5L, 1L, 2L, 3L, 6L, 1L, 2L, 3L, 7L, 4L, 5L, 7L, 4L, 5L, 7L)
    , p = c(0L, 6L, 9L, 14L, 16L, 20L, 24L, 27L, 30L)
    , Dim = c(8L, 8L)
    , Dimnames = list(NULL, NULL)
    , factors = list()
)编辑2月10日‘17日
另一个想法(再一次,考虑到相邻元素只形成矩形/线/点)是迭代-in升序列--通过[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":
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] TRUEhttps://stackoverflow.com/questions/42026273
复制相似问题