有效地比较R中的矩阵

Question

我有一个a包含一些矩阵的数组.现在我需要有效地检查我有多少不同的矩阵以及它们在数组中有哪些索引(按升序排列).我的方法如下:将矩阵的列粘贴为字符向量,并查看频率表,如下所示:

n <- 10 #observations
a <- array(round(rnorm(2*2*n),1),
           c(2,2,n))

paste_a <- apply(a, c(3), paste, collapse=" ") #paste by column
names(paste_a) <- 1:n
freq <- as.numeric( table(paste_a) ) # frequencies of different matrices (in ascending order)
indizes <- as.numeric(names(sort(paste_a[!duplicated(paste_a)]))) 
nr <- length(freq) #number of different matrices

但是,当你增加到n大数时,这会变得非常低效(主要paste()是变得越来越慢).有没有人有更好的解决方案？

这是一个包含100个观测值的"真实"数据集,其中一些矩阵是实际重复的(与我上面的例子相反):https://pastebin.com/aLKaSQyF

非常感谢你.

Answer 1

由于您的实际数据是由整数组成的0,1,2,3,为什么不利用base 4？比整个矩阵对象更快地比较整数.(以下所有出现的内容a都是从链接的实际数据集中找到的数据.)

Base4Approach <- function() {
    toBase4 <- sapply(1:dim(a)[3], function(x) {
        v <- as.vector(a[,,x])
        pows <- which(v > 0)
        coefs <- v[pows]
        sum(coefs*(4^pows))
    })
    myDupes <- which(duplicated(toBase4))
    a[,,-(myDupes)]
}

因为问题是关于效率,让我们的基准:

MartinApproach <- function() {
    ### commented this out for comparison reasons
    # dimnames(a) <- list(1:dim(a)[1], 1:dim(a)[2], 1:dim(a)[3])
    a <- a[,,!duplicated(a, MARGIN = 3)]
    nr <- dim(a)[3]
    a
}

identical(MartinApproach(), Base4Approach())
[1] TRUE

microbenchmark(Base4Approach(), MartinApproach())
Unit: microseconds
            expr     min       lq      mean    median       uq      max neval
 Base4Approach() 291.658  303.525  339.2712  325.4475  352.981  636.361   100
MartinApproach() 983.855 1000.958 1160.4955 1071.9545 1187.321 3545.495   100

@db的方法并不像前两种方法那样做(它只是识别并且不删除重复项).

DBApproach <- function() {
    a[, , 9] = a[, , 1]

    #Convert to list
    mylist = lapply(1:dim(a)[3], function(i) a[1:dim(a)[1], 1:dim(a)[2], i])
    temp = sapply(mylist, function(x) sapply(mylist, function(y) identical(x, y)))
    temp2 = unique(apply(temp, 1, function(x) sort(which(x))))

    #The indices in 'a' where the matrices are same
    temp2[lengths(temp2) > 1]
}

但是,Base4Approach仍占主导地位:

    microbenchmark(Base4Approach(), MartinApproach(), DBApproach())
Unit: microseconds
            expr      min         lq       mean    median         uq       max neval
 Base4Approach()  298.764   324.0555   348.8534   338.899   356.0985   476.475   100
MartinApproach() 1012.601  1087.9450  1204.1150  1110.662  1162.9985  3224.299   100
    DBApproach() 9312.902 10339.4075 11616.1644 11438.967 12413.8915 17065.494   100

更新由@alexis_laz提供

正如@alexis_laz的评论中提到的,我们可以做得更好.

AlexisBase4Approach <- function() {
    toBase4 <- colSums(a * (4 ^ (0:(prod(dim(a)[1:2]) - 1))), dims = 2)
    myDupes <- which(duplicated(toBase4))
    a[,,-(myDupes)]
}

microbenchmark(Base4Approach(), MartinApproach(), DBApproach(), AlexisBase4Approach(), unit = "relative")
Unit: relative
                 expr       min        lq       mean     median         uq        max neval
      Base4Approach()  11.67992  10.55563   8.177654   8.537209   7.128652   5.288112   100
     MartinApproach()  39.60408  34.60546  27.930725  27.870019  23.836163  22.488989   100
         DBApproach() 378.91510 342.85570 262.396843 279.190793 231.647905 108.841199   100
AlexisBase4Approach()   1.00000   1.00000   1.000000   1.000000   1.000000   1.000000   100

## Still gives accurate results
identical(MartinApproach(), AlexisBase4Approach())
[1] TRUE