Есть ли эффективный способ сравнения двух фреймов данных

Question

У меня есть два фрейма данных с разным количеством строк, но одинаковым количеством столбцов. В приведенном ниже примере кадр данных 1 равен 4 x 2, кадр данных 2 - 3 x 2. Мне нужна логическая матрица 4 x 3, где TRUE указывает, что все строки в кадрах данных совпадают. Этот пример работает, но он занимает очень много времени для работы с большими фреймами данных (я пробую два фрейма данных с примерно 5000 строк, но все еще только два столбца). Есть ли более эффективный способ сделать это?

> df1 <- data.frame(row.names=1:4, var1=c(TRUE, TRUE, FALSE, FALSE), var2=c(1,2,3,4))
> df2 <- data.frame(row.names=5:7, var1=c(FALSE, TRUE, FALSE), var2=c(5,2,3))
> 
> m1 <- t(as.matrix(df1))
> m2 <- as.matrix(df2)
> 
> apply(m2, 1, FUN=function(x) { apply(m1, 2, FUN=function(y) { all(x==y) } ) })
      5     6     7
1 FALSE FALSE FALSE
2 FALSE  TRUE FALSE
3 FALSE FALSE  TRUE
4 FALSE FALSE FALSE

Заранее благодарю за любую помощь.

Answer 1

Меня привлекла ваша публикация на R-блогерах: http://jason.bryer.org/posts/2013-01-24/Comparing_Two_Data_Frames.html

Если, как вы говорите, ваши данные не имеют числовых векторов, то я думаю, что могу предложить более быстрый подход. Он состоит в:

1. превратить ваши два data.frames в две матрицы целых чисел
2. вычислить евклидово расстояние между рядами ваших двух данных

Быстрый пример использования ваших данных:

mat1 <- as.matrix(sapply(df1, as.integer))
mat2 <- as.matrix(sapply(df2, as.integer))
library(fields)
rdist(mat1, mat2) < 1e-9
#       [,1]  [,2]  [,3]
# [1,] FALSE FALSE FALSE
# [2,] FALSE  TRUE FALSE
# [3,] FALSE FALSE  TRUE
# [4,] FALSE FALSE FALSE

Несколько комментариев:

1. если ваши данные содержат векторы символов, вам придется преобразовать их в факторы и убедиться, что они имеют одинаковые уровни факторов.
2. Я использовал fields пакет для вычисления евклидова расстояния. Он использует реализацию на Фортране и, насколько мне известно, является самым быстрым пакетом R для этой задачи (и я много тестировал, поверьте мне).

Answer 2

Я честно не уверен, что это будет быстрее, но вы можете попробовать:

foo <- Vectorize(function(x,y) {all(df1[x,] == df2[y,])})
> outer(1:4,1:3,FUN = foo)
      [,1]  [,2]  [,3]
[1,] FALSE FALSE FALSE
[2,] FALSE  TRUE FALSE
[3,] FALSE FALSE  TRUE
[4,] FALSE FALSE FALSE

Я чувствую себя обязанным хотя бы упомянуть об опасности при использовании == для сравнения в отличие от all.equal или же identical, Я предполагаю, что вы достаточно комфортно относитесь к типам данных, что это не будет проблемой.

Answer 3

Я подозреваю, что оптимальное решение зависит от того, сколько уникальных строк и сколько у вас всего строк.

Для примера в вашем блоге, где есть 1000-1500 строк, но только 20 уникальных значений (для заданного вами начального числа), я думаю, что это быстрее сделать:

1. назначить идентификаторы для каждой уникальной строки, а затем
2. запускать external по вектору идентификаторов, видимых в каждом data.frame.

Вот представление, которое я получил. подход @flodel делает примерно то же самое на моем компьютере; это третий ниже. Отказ от ответственности: я не знаю много о проведении таких тестов.

> set.seed(2112)
> df1 <- data.frame(row.names=1:1000, 
+   var1=sample(c(TRUE,FALSE), 1000, replace=TRUE), 
+   var2=sample(1:10, 1000, replace=TRUE) )
> df2 <- data.frame(row.names=1001:2500, 
+   var1=sample(c(TRUE,FALSE), 1500, replace=TRUE),
+   var2=sample(1:10, 1500, replace=TRUE))
> 
> # candidate method on blog  
> system.time({
+  df1$var3 <- apply(df1, 1, paste, collapse='.')
+  df2$var3 <- apply(df2, 1, paste, collapse='.')
+  df6 <- sapply(df2$var3, FUN=function(x) { x == df1$var3 })
+  dimnames(df6) <- list(row.names(df1), row.names(df2))
+ })  
   user  system elapsed 
   1.13    0.00    1.14 
> 
> rownames(df1) <- NULL # in case something weird happens to rownames on merge
> rownames(df2) <- NULL
> # id method  
> system.time({  
+ df12 <- unique(rbind(df1,df2))
+ df12$id <- rownames(df12)
+ 
+ id1 <- merge(df12,df1)$id
+ id2 <- merge(df12,df2)$id
+ 
+ x <- outer(id1,id2,`==`)
+ })
   user  system elapsed 
   0.11    0.02    0.13 
> 
> library(fields)
> # rdlist from fields method
> system.time({  
+ mat1 <- as.matrix(sapply(df1, as.integer))
+ mat2 <- as.matrix(sapply(df2, as.integer))
+ rdist(mat1, mat2) < 1e-9
+ })
   user  system elapsed 
   0.15    0.00    0.16 

Я думаю, rbind и mergeЭто сделало бы это решение относительно более дорогостоящим с другими данными.