Сравнение результатов записи и Double For Loop - PullRequest
Новая
       20

Сравнение результатов записи и Double For Loop

3 голосов
/ 06 марта 2012

У меня есть двойной цикл, который мне не только не нравится, но мне потребуется 14 дней для запуска на моем компьютере, так как он обрабатывает 3200 записей и 1090 переменных со скоростью примерно .12 за итерацию.

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

y <- data.frame(c(1,2,1,NA,NA),c(3,3,3,4,NA),c(5,4,5,7,7),c(7,8,7,9,10))
resultdf <- NULL
for(i in 1:nrow(y))
{
  results <- NULL
  for(j in 1:nrow(y))
  {
    results <- c(results,sum((y[i,]==y[j,]),na.rm=TRUE))
  }
  resultdf <- cbind(resultdf,results)
}
y <- cbind(y,resultdf)

У меня есть повторные расчеты, которых можно было бы избежать, если оставить около 7 дней.

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

Спасибо!

Ответы [ 4 ]

3 голосов
/ 06 марта 2012

Вот еще одно решение, использующее outer. 

f <- function(i,j) sum(y[i,] == y[j,], na.rm=TRUE)
d <- outer( 1:nrow(y), 1:nrow(y), Vectorize(f) )
3 голосов
/ 06 марта 2012

Я создал данные в соответствии с вашими требованиями и использовал предложение @ BenBolker об использовании матрицы: 

> y <- matrix(sample(c(1:9, NA), 3200 * 1090, replace = TRUE),
+             nrow = 3200, ncol = 1090)

и сравнил время вычислений для трех разных реализаций:

f1 было предложено @Andrei: 

> f1 <- function(y)apply(y, 1, function(r1)
+                  apply(y, 1, function(r2)sum(r1==r2, na.rm=TRUE)))

> system.time(r1 <- f1(y))
   user  system elapsed 
 523.51    0.77  528.73

f2 было предложено @VincentZoonekynd: 

> f2 <- function(y) {
+   f <- function(i,j) sum(y[i,] == y[j,], na.rm=TRUE)
+   d <- outer( 1:nrow(y), 1:nrow(y), Vectorize(f) )
+   return(d)
+ }
> system.time(r2 <- f2(y))
   user  system elapsed 
 658.94    1.96  710.67

f3 - это двойная петля над верхним треугольником, предложенная @BenBolker. Он также немного более эффективен, чем ваш OP, поскольку он предварительно выделяет выходную матрицу: 

> f3 <- function(y) {
+   result <- matrix(NA, nrow(y), nrow(y))
+   for (i in 1:nrow(y)) {
+     row1 <- y[i, ]
+     for (j in i:nrow(y)) {
+       row2 <- y[j, ]
+       num.matches  <- sum(row1 == row2, na.rm = TRUE)
+       result[i, j] <- num.matches
+       result[j, i] <- num.matches
+     }
+   }
+   return(result)
+ }

> system.time(r3 <- f3(y))
   user  system elapsed 
 167.66    0.08  168.72

Таким образом, двойная петля является самой быстрой из всех трех, хотя и не так элегантна и компактна, как остальные два ответа.

2 голосов
/ 06 марта 2012

Действительно, вы можете использовать функцию применить.Учитывая более ранний намек на то, что матрица работает быстрее, я бы попробовал: 

ym <- as.matrix(y)
resultdf <- apply(ym, 1, function(r1) apply(ym, 1, function(r2) sum(r1==r2, na.rm=TRUE)))
1 голос
/ 06 марта 2012

Вы можете избавиться от внутреннего цикла (используя y и f3 из ответа @ flodel): 

ty <- t(y)
ix <- rep(1:nrow(y),each = ncol(y))
f4 <- function(y){
    result <- matrix(0L, nrow(y), nrow(y))
    for(r in 1:nrow(y))
        result[r,] <- rowsum(as.numeric(ty == y[r,]), ix, na.rm = T)
    result
}



> system.time(out <- f4(y))
   user  system elapsed 
 52.616  21.061  74.000 
> system.time(out <- f3(y))
   user  system elapsed 
244.751   0.136 244.954 
>

На самом деле он выполняет дополнительную работу, вычисляя вдвое больше, но все равно в 5 раз быстрее. Вы можете сделать это еще в 4 раза быстрее, используя внутреннюю работу rowum. См. вопрос для примера.

...