Эффективно сравнивать матрицы в R

у меня есть массив 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

большое спасибо.

8
matrix performance r

3 ответов

поскольку ваши фактические данные состоят из целых чисел 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

подход @d.b. на самом деле не делает то же самое, что и предыдущие два подхода (это просто идентифицирует и не удаляет дубликаты).

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
9

моя первая попытка была на самом деле очень медленно. Итак, вот немного измененная версия вашего:

  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] #number of different matrices
  idx <- dimnames(a)[[3]] # indices of left over matrices
3

Я не знаю, если это именно то, что вы хотите, но вот способ извлечения индексов, где матрицы одинаковы. Может потребоваться дополнительная обработка, чтобы получить то, что вы хотите

#DATA
n <- 10
a <- array(round(rnorm(2*2*n),1), c(2,2,n))
a[, , 9] = a[, , 1]

temp = unique(apply(X = sapply(1:dim(a)[3], function(i)
    sapply(1:dim(a)[3], function(j) identical(a[, , i], a[, , j]))),
    MARGIN = 1,
    FUN = function(x) sort(which(x))))
temp[lengths(temp) > 1]
#[[1]]
#[1] 1 9
2