do.call(rbind, list) para un número desigual de columnas

data-binding

Question

Tengo una lista, con cada elemento es un vector de caracteres, de diferentes longitudes Me gustaría vincular los datos como filas, de modo que los nombres de columna ''alinear'' y si hay datos adicionales, a continuación, crear columna y si hay datos faltantes luego crea NA

A continuación se muestra un ejemplo falso de los datos con los que estoy trabajando

x <- list()
x[[1]] <- letters[seq(2,20,by=2)]
names(x[[1]]) <- LETTERS[c(1:length(x[[1]]))]
x[[2]] <- letters[seq(3,20, by=3)]
names(x[[2]]) <- LETTERS[seq(3,20, by=3)]
x[[3]] <- letters[seq(4,20, by=4)]
names(x[[3]]) <- LETTERS[seq(4,20, by=4)]

La línea siguiente sería normalmente lo que haría si estuviera seguro de que el formato de cada elemento era el mismo ...

do.call(rbind,x)

Tenía la esperanza de que alguien hubiera encontrado una pequeña solución que coincida con los nombres de las columnas y llene los espacios en blanco con las de NA , mientras que agrega nuevas columnas si en el proceso de enlace se encuentran nuevas columnas ...

Answer 1

Si quieres que el resultado sea una matriz ...

Hace poco escribí esta función para un compañero de trabajo que quería vincular vectores en una matriz.

foo <- function (...) 
{
  dargs <- list(...)
  if (!all(vapply(dargs, is.vector, TRUE))) 
      stop("all inputs must be vectors")
  if (!all(vapply(dargs, function(x) !is.null(names(x)), TRUE))) 
      stop("all input vectors must be named.")
  all.names <- unique(names(unlist(dargs)))
  out <- do.call(rbind, lapply(dargs, `[`, all.names))
  colnames(out) <- all.names
  out
}

R > do.call(foo, x)
     A   B   C   D   E   F   G   H   I   J   L   O   R   P   T  
[1,] "b" "d" "f" "h" "j" "l" "n" "p" "r" "t" NA  NA  NA  NA  NA 
[2,] NA  NA  "c" NA  NA  "f" NA  NA  "i" NA  "l" "o" "r" NA  NA 
[3,] NA  NA  NA  "d" NA  NA  NA  "h" NA  NA  "l" NA  NA  "p" "t"

Answer 2

rbind.fill es una función increíble que funciona muy bien en la lista de data.frames. Pero en mi humilde opinión, en este caso, podría hacerse mucho más rápido cuando la lista contenga solo vectores (con nombre).

La forma rbind.fill

require(plyr)
rbind.fill(lapply(x,function(y){as.data.frame(t(y),stringsAsFactors=FALSE)}))

Una manera más directa (y eficiente para este escenario al menos):

rbind.named.fill <- function(x) {
    nam <- sapply(x, names)
    unam <- unique(unlist(nam))
    len <- sapply(x, length)
    out <- vector("list", length(len))
    for (i in seq_along(len)) {
        out[[i]] <- unname(x[[i]])[match(unam, nam[[i]])]
    }
    setNames(as.data.frame(do.call(rbind, out), stringsAsFactors=FALSE), unam)
}

Básicamente, obtenemos nombres únicos totales para formar las columnas del data.frame final. Luego, creamos una lista con length = input y simplemente llenamos el resto de los valores con NA . Esta es probablemente la parte más "difícil" ya que tenemos que coincidir con los nombres mientras llenamos NA. Y luego, fijamos los nombres una vez finalmente en las columnas (que se pueden establecer por referencia usando setnames del paquete data.table también, si es necesario).

Ahora a algunos puntos de referencia:

Datos:

# generate some huge random data:
set.seed(45)
sample.fun <- function() {
    nam <- sample(LETTERS, sample(5:15))
    val <- sample(letters, length(nam))
    setNames(val, nam)  
}
ll <- replicate(1e4, sample.fun())

Funciones:

# plyr''s rbind.fill version:
rbind.fill.plyr <- function(x) {
    rbind.fill(lapply(x,function(y){as.data.frame(t(y),stringsAsFactors=FALSE)}))
}

rbind.named.fill <- function(x) {
    nam <- sapply(x, names)
    unam <- unique(unlist(nam))
    len <- sapply(x, length)
    out <- vector("list", length(len))
    for (i in seq_along(len)) {
        out[[i]] <- unname(x[[i]])[match(unam, nam[[i]])]
    }
    setNames(as.data.frame(do.call(rbind, out), stringsAsFactors=FALSE), unam)
}

Actualización (también se agregó la función de GSee):

foo <- function (...) 
{
  dargs <- list(...)
  all.names <- unique(names(unlist(dargs)))
  out <- do.call(rbind, lapply(dargs, `[`, all.names))
  colnames(out) <- all.names
  as.data.frame(out, stringsAsFactors=FALSE)
}

Benchmarking:

require(microbenchmark)
microbenchmark(t1 <- rbind.named.fill(ll), 
               t2 <- rbind.fill.plyr(ll), 
               t3 <- do.call(foo, ll), times=10)
identical(t1, t2) # TRUE
identical(t1, t3) # TRUE

Unit: milliseconds
                       expr        min         lq     median         uq        max neval
 t1 <- rbind.named.fill(ll)   243.0754   258.4653   307.2575   359.4332   385.6287    10
  t2 <- rbind.fill.plyr(ll) 16808.3334 17139.3068 17648.1882 17890.9384 18220.2534    10
     t3 <- do.call(foo, ll)   188.5139   204.2514   229.0074   339.6309   359.4995    10