Более быстрое умножение матриц путем замены двойного цикла - PullRequest
Новая
       13

Более быстрое умножение матриц путем замены двойного цикла

6 голосов
/ 30 октября 2019

У меня есть фрейм данных, который выглядит немного, как показано в следующем коде (но гораздо больше) 

set.seed(10)    
mat <- matrix(rbinom(200, size=1, prob = .5), ncol = 10)

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

Я создал следующий код, который, кажется, работает нормально: 

mat2 <- matrix(NA,20,20)

for(i in 1:nrow(mat)){
    for(j in 1:nrow(mat)){
       mat2[i,j] <- sum(as.numeric(mat[i,]==1) + as.numeric(mat[j,]==1) == 2)
    }
 }

Таким образом, я сравниваю каждую запись с каждой другой записью, и только если у обеих есть 1 запись (то есть, они заинтересованы), то эта сумма равна 2 и будет учитываться как совместный интерес к теме.

Моя проблема в том, что мой набор данных очень большой, и цикл теперь работает уже несколько часов.

У кого-нибудь есть идеи, как это сделать, избегая петли?

Ответы [ 2 ]

5 голосов
/ 30 октября 2019

продвигаем дальше и продвигаем комментарий @ jogo, так как он является самым быстрым (спасибо за подсказку, я буду использовать его и в производстве). 

set.seed(10)    
mat <- matrix(rbinom(200, size=1, prob = .5), ncol = 10)
mat2 <- matrix(NA,20,20)
binary_mat <- mat == 1
tmat <- t(mat==1)

microbenchmark::microbenchmark(
  "loop" = for(i in 1:nrow(mat)){
             for(j in 1:nrow(mat)){
               mat2[i,j] <- sum(as.numeric(mat[i,]==1) + as.numeric(mat[j,]==1) == 2)
             }
           }, 
  "apply" = mat4 <- apply(tmat, 2, function(x) colSums(tmat & x)), 
  "matrix multiplication" = mat5 <- mat %*% t(mat),
  "tcrossprod" = tcrossprod(mat),
  "tcrossprod binary" = tcrossprod(binary_mat)
)

На моей машине этот тест дает 

Unit: microseconds
                  expr       min        lq        mean    median         uq       max neval cld
                  loop 16699.634 16972.271 17931.82535 17180.397 17546.1545 31502.706   100   b
                 apply   322.942   330.046   395.69045   357.886   368.8300  4299.228   100  a 
 matrix multiplication    21.889    28.801    36.76869    39.360    43.9685    50.689   100  a 
            tcrossprod     7.297     8.449    11.20218     9.984    14.4005    18.433   100  a 
     tcrossprod binary     7.680     8.833    11.08316     9.601    12.0970    35.713   100  a
5 голосов
/ 30 октября 2019

Это должно быть быстрее: 

tmat <- t(mat==1)
mat4 <- apply(tmat, 2, function(x) colSums(tmat & x))
...