Эффективный способ rbind data.frames с разными столбцами

У меня есть список фреймов данных с различными наборами столбцов. Я хотел бы объединить их по строкам в один фрейм данных. Я использую plyr::rbind.fill для этого. Я ищу что-то, что сделало бы это более эффективно, но похоже на ответ, приведенный здесь.

require(plyr)

set.seed(45)
sample.fun <- function() {
   nam <- sample(LETTERS, sample(5:15))
   val <- data.frame(matrix(sample(letters, length(nam)*10,replace=TRUE),nrow=10))
   setNames(val, nam)  
}
ll <- replicate(1e4, sample.fun())
rbind.fill(ll)

ОТВЕТЫ

Ответ 1

ОБНОВЛЕНИЕ: см. Этот обновленный ответ вместо.

ОБНОВЛЕНИЕ (eddi): теперь это реализовано в версии 1.8.11 в качестве аргумента fill для rbind. Например:

DT1 = data.table(a = 1:2, b = 1:2)
DT2 = data.table(a = 3:4, c = 1:2)

rbind(DT1, DT2, fill = TRUE)
#   a  b  c
#1: 1  1 NA
#2: 2  2 NA
#3: 3 NA  1
#4: 4 NA  2

Добавлена FR # 4790 - функция, похожая на rbind.fill (из plyr) для объединения списка data.frames/data.tables

Примечание 1:

Это решение использует функцию data.table rbindlist для "rbind" списка data.tables, и для этого обязательно используйте версию 1.8.9 из-за этой ошибки в версиях <1.8.9.

Заметка 2:

rbindlist при связывании списков data.frames/data.tables, на данный момент, будет сохранять тип данных первого столбца. То есть, если столбец в первом data.frame является символом, а тот же столбец во втором data.frame является "factor", то rbindlist приведет к тому, что этот столбец будет символом. Итак, если ваш data.frame состоит из всех символьных столбцов, то ваше решение с этим методом будет идентично методу plyr. Если нет, значения будут такими же, но некоторые столбцы будут символьными, а не факторными. Вы должны будете преобразовать в "фактор" самостоятельно после. Надеюсь, это поведение изменится в будущем.

А теперь вот с помощью data.table (и сравнительного сравнения с rbind.fill из plyr):

require(data.table)
rbind.fill.DT <- function(ll) {
    # changed sapply to lapply to return a list always
    all.names <- lapply(ll, names)
    unq.names <- unique(unlist(all.names))
    ll.m <- rbindlist(lapply(seq_along(ll), function(x) {
        tt <- ll[[x]]
        setattr(tt, 'class', c('data.table', 'data.frame'))
        data.table:::settruelength(tt, 0L)
        invisible(alloc.col(tt))
        tt[, c(unq.names[!unq.names %chin% all.names[[x]]]) := NA_character_]
        setcolorder(tt, unq.names)
    }))
}

rbind.fill.PLYR <- function(ll) {
    rbind.fill(ll)
}

require(microbenchmark)
microbenchmark(t1 <- rbind.fill.DT(ll), t2 <- rbind.fill.PLYR(ll), times=10)
# Unit: seconds
#                      expr      min        lq    median        uq       max neval
#   t1 <- rbind.fill.DT(ll)  10.8943  11.02312  11.26374  11.34757  11.51488    10
# t2 <- rbind.fill.PLYR(ll) 121.9868 134.52107 136.41375 184.18071 347.74724    10


# for comparison change t2 to data.table
setattr(t2, 'class', c('data.table', 'data.frame'))
data.table:::settruelength(t2, 0L)
invisible(alloc.col(t2))
setcolorder(t2, unique(unlist(sapply(ll, names))))

identical(t1, t2) # [1] TRUE

Следует отметить, что plyr rbind.fill мимо этого конкретного решения data.table до размера списка около 500.

Контрольный участок:

Здесь представлен график с длиной списка data.frames с seq(1000, 10000, by=1000). Я использовал microbenchmark с 10 повторениями в каждой из этих разных длин списка.

enter image description here

Суть бенчмаркинга:

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

Ответ 2

Теперь, когда rbindlist (и rbind) для data.table имеет улучшенные функциональные возможности и скорость с последние изменения/фиксации в v1.9.3 (версия для разработки), а dplyr имеет более быструю версию plyr rbind.fill, названный rbind_all, этот ответ, по-моему, немного слишком устаревший.

Здесь соответствующая запись НОВОСТИ для rbindlist:

o  'rbindlist' gains 'use.names' and 'fill' arguments and is now implemented entirely in C. Closes #5249    
  -> use.names by default is FALSE for backwards compatibility (doesn't bind by 
     names by default)
  -> rbind(...) now just calls rbindlist() internally, except that 'use.names' 
     is TRUE by default, for compatibility with base (and backwards compatibility).
  -> fill by default is FALSE. If fill is TRUE, use.names has to be TRUE.
  -> At least one item of the input list has to have non-null column names.
  -> Duplicate columns are bound in the order of occurrence, like base.
  -> Attributes that might exist in individual items would be lost in the bound result.
  -> Columns are coerced to the highest SEXPTYPE, if they are different, if/when possible.
  -> And incredibly fast ;).
  -> Documentation updated in much detail. Closes DR #5158.

Итак, я сравнивал новые (и более быстрые версии) с относительно большими данными ниже.

Новый контрольный показатель:

Мы создадим в общей сложности 10 000 data.tables с столбцами в диапазоне от 200 до 300 с общим количеством столбцов после привязки до 500.

Функции для создания данных:

require(data.table) ## 1.9.3 commit 1267
require(dplyr)      ## commit 1504 devel
set.seed(1L)
names = paste0("V", 1:500)
foo <- function() {
    cols = sample(200:300, 1)
    data = setDT(lapply(1:cols, function(x) sample(10)))
    setnames(data, sample(names)[1:cols])
}
n = 10e3L
ll = vector("list", n)
for (i in 1:n) {
    .Call("Csetlistelt", ll, i, foo())
}

И вот тайминг:

## Updated timings on data.table v1.9.5 - three consecutive runs:
system.time(ans1 <- rbindlist(ll, fill=TRUE))
#   user  system elapsed 
#  1.993   0.106   2.107 
system.time(ans1 <- rbindlist(ll, fill=TRUE))
#   user  system elapsed 
#  1.644   0.092   1.744 
system.time(ans1 <- rbindlist(ll, fill=TRUE))
#   user  system elapsed 
#  1.297   0.088   1.389 


## dplyr rbind_all - Timings for three consecutive runs
system.time(ans2 <- rbind_all(ll))
#   user  system elapsed  
#  9.525   0.121   9.761 

#   user  system elapsed  
#  9.194   0.112   9.370 

#   user  system elapsed  
#  8.665   0.081   8.780 

identical(ans1, setDT(ans2)) # [1] TRUE

Ответ 3

Есть еще что-то, что можно получить, если вы распараллеливаете как rbind.fill, так и rbindlist. Результаты выполняются с помощью data.table версии 1.8.8, поскольку версия 1.8.9 была закрашена, когда я попробовал ее с помощью параллелизированной функции. Таким образом, результаты не идентичны между data.table и plyr, но они идентичны в рамках решения data.table или plyr. Значение parallel plyr соответствует непараллельному plyr и наоборот.

Вот эталон/скрипты. parallel.rbind.fill.DT выглядит ужасно, но самый быстрый, который я мог бы вытащить.

require(plyr)
require(data.table)
require(ggplot2)
require(rbenchmark)
require(parallel) 

# data.table::rbindlist solutions
rbind.fill.DT <- function(ll) {
  all.names <- lapply(ll, names)
  unq.names <- unique(unlist(all.names))
  rbindlist(lapply(seq_along(ll), function(x) {
    tt <- ll[[x]]
    setattr(tt, 'class', c('data.table', 'data.frame'))
    data.table:::settruelength(tt, 0L)
    invisible(alloc.col(tt))
    tt[, c(unq.names[!unq.names %chin% all.names[[x]]]) := NA_character_]
    setcolorder(tt, unq.names)
  }))
}

 parallel.rbind.fill.DT <- function(ll, cluster=NULL){
   all.names <- lapply(ll, names)
   unq.names <- unique(unlist(all.names)) 
   if(is.null(cluster)){
     ll.m <- rbindlist(lapply(seq_along(ll), function(x) {
       tt <- ll[[x]]
       setattr(tt, 'class', c('data.table', 'data.frame'))
       data.table:::settruelength(tt, 0L)
       invisible(alloc.col(tt))
       tt[, c(unq.names[!unq.names %chin% all.names[[x]]]) := NA_character_]
       setcolorder(tt, unq.names)
     }))
   }else{
     cores <- length(cluster)
     sequ <- as.integer(seq(1, length(ll), length.out = cores+1))
     Call <- paste(paste("list", seq(cores), sep=""), " = ll[", c(1, sequ[2:cores]+1), ":", sequ[2:(cores+1)], "]", sep="", collapse=", ") 
     ll <- eval(parse(text=paste("list(", Call, ")")))
     rbindlist(clusterApply(cluster, ll, function(ll, unq.names){
        rbindlist(lapply(seq_along(ll), function(x, ll, unq.names) {
          tt <- ll[[x]]
          setattr(tt, 'class', c('data.table', 'data.frame'))
          data.table:::settruelength(tt, 0L)
          invisible(alloc.col(tt))
          tt[, c(unq.names[!unq.names %chin% colnames(tt)]) := NA_character_]
          setcolorder(tt, unq.names)
        }, ll=ll, unq.names=unq.names))
      }, unq.names=unq.names))
    }
  }           


# plyr::rbind.fill solutions
rbind.fill.PLYR <- function(ll) {
  rbind.fill(ll)
}

parallel.rbind.fill.PLYR <- function(ll, cluster=NULL, magicConst=400){
  if(is.null(cluster) | ceiling(length(ll)/magicConst) < length(cluster)){
    rbind.fill(ll)
  }else{
    cores <- length(cluster)
    sequ <- as.integer(seq(1, length(ll), length.out = ceiling(length(ll)/magicConst)))
    Call <- paste(paste("list", seq(cores), sep=""), " = ll[", c(1, sequ[2:(length(sequ)-1)]+1), ":", sequ[2:length(sequ)], "]", sep="", collapse=", ") 
    ll <- eval(parse(text=paste("list(", Call, ")")))
    rbind.fill(parLapply(cluster, ll, rbind.fill))
  }
} 

# Function to generate sample data of varying list length
set.seed(45)
sample.fun <- function() {
  nam <- sample(LETTERS, sample(5:15))
  val <- data.frame(matrix(sample(letters, length(nam)*10,replace=TRUE),nrow=10))
  setNames(val, nam)
}

ll <- replicate(10000, sample.fun())
cl <- makeCluster(4, type="SOCK")
clusterEvalQ(cl, library(data.table))
clusterEvalQ(cl, library(plyr))
benchmark(t1 <- rbind.fill.PLYR(ll),
  t2 <- rbind.fill.DT(ll),
  t3 <- parallel.rbind.fill.PLYR(ll, cluster=cl, 400),
  t4 <- parallel.rbind.fill.DT(ll, cluster=cl),
  replications=5)
stopCluster(cl)

# Results for rbinding 10000 dataframes
# done with 4 cores, i5 3570k and 16gb memory
# test                          reps elapsed relative 
# rbind.fill.PLYR                 5  321.80    16.682   
# rbind.fill.DT                   5   26.10    1.353    
# parallel.rbind.fill.PLYR        5   28.00    1.452     
# parallel.rbind.fill.DT          5   19.29    1.000    

# checking are results equal
t1 <- as.matrix(t1)
t2 <- as.matrix(t2)
t3 <- as.matrix(t3)
t4 <- as.matrix(t4)

t1 <- t1[order(t1[, 1], t1[, 2]), ]
t2 <- t2[order(t2[, 1], t2[, 2]), ]
t3 <- t3[order(t3[, 1], t3[, 2]), ]
t4 <- t4[order(t4[, 1], t4[, 2]), ]

identical(t2, t4) # TRUE
identical(t1, t3) # TRUE
identical(t1, t2) # FALSE, mismatch between plyr and data.table

Как вы видите, parallesizing rbind.fill сделал его сопоставимым с data.table, и вы могли бы получить предельное увеличение скорости путем parallesizing data.table даже с этим минимумом числа кадров данных.