из цикла for применять для ускорения в R

Question

Я запускаю цикл for с двумя матрицами. Один matrix(A) имеет ~ 100 строк (например, name1, name2, ..., name100) и имеет только один столбец. Другой matrix(B) больше A со строками и столбцами значений и строк. В некоторых местах в матрице B каждое имя матрицы A совпадает. Я хотел бы извлечь и сложить совпадающие целые строки с определенной строкой матрицы A в выходной матрице.

Итак, я бегу, как показано ниже,

output <- NULL
for(K in 1:nrow(A)){
  print(K)
  for(cc in 1:nrow(B)){
    for(dd in 1:ncol(B)){
      if(toupper(A[K])==toupper(B[cc,dd])){
        output <- rbind(output,B[cc,])
      }
    }
  }
}

Но это слишком медленно. Как сделать цикл for более эффективным с точки зрения времени выполнения?

Answer 1

Проблема со скоростью не из-за цикла.apply, вероятно, будет еще медленнее.Вам нужно предварительно измерить целевой объект и присвоить значения с помощью индексации.

Или вам нужно подумать о векторизованном решении, например ... работающем на тестовом примере Мануэля:

 idx <- unique(which(toupper(as.matrix(B)) %in% toupper(A), arr.ind=TRUE) %% NROW(B))
 idx[idx==0] <- 4
     B[idx , ]
  z1         z2 z3
1  a  1.5623285  a
4  c -1.2196311  f
2  g  0.2551535  b

Answer 2

Вот быстрое решение, которое должно давать тот же результат, что и ваш:

set.seed(13)
A <- matrix(letters[1:5])
B <- matrix(sample(letters, 12, rep(T)), 4)

x <- match(toupper(A), toupper(B), nomatch=0L)
x <- (x[x>0L]-1L) %% nrow(B) + 1L
output <- B[x, , drop=FALSE]

Это работает с помощью match, чтобы найти (векторные) индексы в B, где A соответствует.Затем он преобразует эти индексы в индексы строк и, наконец, извлекает эти строки.

.. Обратите внимание, что строка B[2,] включена дважды в вывод - это действительно то, что вы хотите?Если нет, измените последнюю строку на:

output <- B[unique(x), , drop=FALSE]

РЕДАКТИРОВАТЬ Некоторые моменты времени.Я удалил вызовы toupper, так как это доминирует во времени, и @Manuel Ramon не звонил.Обратите внимание, что все наши результаты разные!Так что некоторая отладка, вероятно, оправдана; -)

# Create huge A and B matrices
set.seed(13)
strs <- outer(letters, LETTERS, paste)
A <- matrix(strs)
B <- matrix(sample(strs, 1e7, rep(T)), 1e4)

# My solution: 0.24 secs   
system.time({
 x <- match(A, B, nomatch=0L)
 x <- (x[x>0L]-1L) %% nrow(B) + 1L
 output1 <- B[unique(x), , drop=FALSE]
})

# @DWin's solution: 0.91 secs
system.time({
 idx <- unique(which(as.matrix(B) %in% A, arr.ind=TRUE) %% NROW(B))
 idx[idx==0] <- 4
 output2 <- B[idx, , drop=FALSE]
})

# @Manuel Ramon's solution: 0.89 secs
system.time({
  id <- apply(B, 2, function(x) A %in% x)
  output3 <- B[apply(id,1,sum)>0, ]
}) 

Answer 3

Вот некоторая идея:

A <- matrix(c('a','b','c','d'), ncol=1)
B <- data.frame(z1=c('a','g','f','c'), z2=rnorm(4), z3=c('a','b','f','f'))

id <- apply(B, 2, function(x) A %in% x)
newB <- B[apply(id,1,sum)>0, ]