对于来自 {Matrix} 的稀疏矩阵,是否有 R 函数 duplicated() 的方法?

Is there a method with R function duplicated() for a sparse matrix from {Matrix}?

有没有一种简单的方法可以为duplicated编写一个dgCMatrix class的方法?这是一个小例子,所需的输出是 which(duplicated(as.matrix(A), MARGIN = 2)).

# assign example
library(Matrix)
i <- c(1,     3:7, 2, 1, 2, 3)
j <- c(2,  1, 3:6, 1, 7, 8, 8)
x <- c(1:7, 1, 7, 2)
(A <- sparseMatrix(i, j, x = x))
#R 7 x 8 sparse Matrix of class "dgCMatrix"
#R 
#R [1,] . 1 . . . . 1 .
#R [2,] 7 . . . . . . 7
#R [3,] 2 . . . . . . 2
#R [4,] . . 3 . . . . .
#R [5,] . . . 4 . . . .
#R [6,] . . . . 5 . . .
#R [7,] . . . . . 6 . .

# column 7 and 8 match with 1 and 2
which(duplicated(as.matrix(A), MARGIN = 2))
#R [1] 7 8

duplicated(A)
#R Error in duplicated.default(A) : duplicated() applies only to vectors

尽管我使用的矩阵相当大,所以我想避免将矩阵转换为密集矩阵。出于同样的原因,该功能也应该很快。

到目前为止我最好的选择是查看 the code for duplicated 并可能使用 Rccp.

编写等效函数

我的想法是将这个稀疏矩阵恢复成一个列表,RowLstColLst,这样Rowlst[[i]]ColLst[[i]]就是第i个的压缩向量第行或列。然后在此列表上应用duplicated

duplicated.dgCMatrix <- function (dgCMat, MARGIN, include.all.zero.vectors = TRUE) {
  MARGIN <- as.integer(MARGIN)
  J <- rep(1:ncol(dgCMat), diff(dgCMat@p))
  I <- dgCMat@i + 1
  x <- dgCMat@x
  if (MARGIN == 1L) {
    ## check duplicated rows
    names(x) <- J
    if (include.all.zero.vectors) {
      RowLst <- split(x, factor(I, levels = 1:nrow(dgCMat)))
      } else {
      RowLst <- split(x, I)  ## will do `factor(I)` internally in `split`
      }
    result <- duplicated.default(RowLst)
    } else if (MARGIN == 2L) {
    ## check duplicated columns
    names(x) <- I
    if (include.all.zero.vectors) {
      ColLst <- split(x, factor(J, levels = 1:ncol(dgCMat)))
      } else {
      ColLst <- split(x, J)  ## will do `factor(J)` internally in `split`
      }
    result <- duplicated.default(ColLst)
    } else {
    warning("invalid MARGIN; return NULL")
    result <- NULL
    }
  result
  }

which(duplicated.dgCMatrix(A, 2))
#[1] 7 8

我和 20650 之间的讨论揭示了一些值得评论的东西。

  1. 我没有意识到通过上述自定义函数,S3 方法调度适用于 S4 对象。所以,which(duplicated(A, 2)) 就足够了。
  2. duplicated.matrix(t(A))duplicated.array(A, MARGIN = 2) return 也是正确的结果。起初我们以为我们发现了一个隐藏的宝藏,但通过查看他们的来源我们发现他们都依赖于apply,这将对二维输入对象进行as.matrix

OP 在他的申请中占有一席之地。原始解决方案不考虑全零行/列。添加参数 include.all.zero.vectors 的新版本解决了这个问题。基本上我们控制用于 split 的因子水平,以便为全零行/列分配列表中的 NULL 条目而不是被忽略。

效果很好,除非有纯零列。例如,

library(Matrix)
i <- c(1, 1, 1, 2, 1)
j <- c(1, 2, 4, 4, 6)
x <- c(1, 1, 2, 3, 1)
(A <- sparseMatrix(i, j, x = x))
#R 2 x 6 sparse Matrix of class "dgCMatrix"
#R 
#R [1,] 1 1 . 2 . 1
#R [2,] . . . 3 . .

which(duplicated(as.matrix(A), MARGIN = 2))
#R [1] 2 5 6
which(duplicated.dgCMatrix(A, 2))
#R [1] 2 4

稍作修改即可解决此问题

duplicated.dgCMatrix <- function (dgCMat, MARGIN) {
  MARGIN <- as.integer(MARGIN)
  n <- nrow(dgCMat)
  p <- ncol(dgCMat)
  J <- rep(1:p, diff(dgCMat@p))
  I <- dgCMat@i + 1
  x <- dgCMat@x
  if (MARGIN == 1L) {
    ## check duplicated rows
    names(x) <- J
    RowLst <- split(x, I)
    is_empty <- setdiff(1:n, I)
    result <- duplicated.default(RowLst)
  } else if (MARGIN == 2L) {
    ## check duplicated columns
    names(x) <- I
    ColLst <- split(x, J)
    is_empty <- setdiff(1:p, J)
    result <- duplicated.default(ColLst)
  } else {
    warning("invalid MARGIN; return NULL")
    result <- NULL
  }
  
  if(any(is_empty)){
    out <- logical(if(MARGIN == 1L) n else p)
    out[-is_empty] <- result
    if(length(is_empty) > 1)
      out[is_empty[-1]] <- TRUE
    result <- out
  }
  
  result
}

之后我们得到

which(duplicated.dgCMatrix(A, 2))
#R [1] 2 5 6

# check that it works with the transpose
which(duplicated.dgCMatrix(t(A), 1))
#R [1] 2 5 6