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