logo标签列表

针对列数不均的情况，使用do.call(rbind, list)。

rlistdata-binding
20

我有一个列表，每个元素都是不同长度的字符向量。我想将数据绑定为行，以便列名“对齐”，如果有额外数据，则创建列，如果缺少数据，则创建NAs。

下面是我正在处理的模拟数据示例。

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)]

如果我确信每个元素的格式都相同，以下行通常是我要执行的操作...

do.call(rbind,x)

我希望有人能提供一个简单的解决方案，它可以将列名匹配起来，在填充空白值为NA的同时，如果在合并过程中发现新列，则添加新列...

6
plyr:::rbind.fill：将数据框的列表按行连接起来，用NA填充缺失的列。 - Roman Luštrik
plyr:::rbind.fill(lapply(x,function(y){as.data.frame(t(y))})) 将所有字符转换为因子...有没有什么方法可以摆脱这个问题？ - h.l.m
事后做。转置变量会无意中将其更改为矩阵。一旦它强制转换回数据框，字符将被编码为因子。 - Roman Luštrik
1
实际上已经得到了它... rbind.fill(lapply(x,function(y){as.data.frame(t(y),stringsAsFactors=FALSE)})) - h.l.m
@h.l.m，这样做会非常低效，因为您需要在每个列表元素上调用as.data.frame。我不认为这是“最佳/最快”的解决方案。 - Arun
4个回答
30

rbind.fill是一个很棒的函数，对于数据框列表表现得非常出色。但在我看来，如果列表只包含（命名）向量，它可以更快地完成。

rbind.fill方式

require(plyr)
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)
}

基本上，我们获取总共的“唯一名称”以形成最终数据框的列。然后，我们创建一个长度为输入值的列表，并将其余的值填充为“NA”。这可能是最棘手的部分，因为我们必须在填充NA时匹配名称。然后，我们最终将名称设置为列名（如果需要，可以使用data.table包中的setnames通过引用设置列）。
现在进行一些基准测试：

数据：

# 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())

功能：

# 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)
}

更新（添加了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
1
如果你对基准测试加1，我认为我的代码甚至可能会稍微领先一些，但它们的速度非常接近；参数检查可能是值得的。如果你删除了参数检查（即使用vapply的if语句），我认为我的代码甚至可能会稍微领先一些。 - GSee
1
@GSee，说得好。我今天本来就要改变它。现在我已经做到了。确实，它更快。无论如何，在代码紧凑性和思路方面，我喜欢你的。 - Arun
我会在rbind.named.fill()中使用lapply()而不是sapply()，因为sapply()会将_nam_简化为矩阵，并且unique()在矩阵和列表上的处理方式不同。 - andschar
9

如果您希望结果是一个矩阵...

我最近为一位同事编写了这个函数，他想要将向量按行合并成矩阵。

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"
2
这里有一个使用data.table包的版本，对于非常大的数据来说速度更快。它使用rbindlist函数和传递给do.call函数的参数fill=TRUE。"最初的回答"
library(data.table)
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)]


x2 <- lapply(x, as.list)
rbindlist(x2, fill=TRUE)
#>       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

它增加了一些开销，因为它需要使用as.list将字符向量转换。这可能会根据数据生成的方式而在过程中增加时间。
另一方面，它似乎在大型数据集上表现更快。
它返回一个data.table。

我改写了@Arun和@GSee的示例以生成更大的样本。

数据

# 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)  
}
l1 <- replicate(1e6, sample.fun()) # Arun's data, just bigger
l2 <- lapply(l1, as.list) # same data converted with as.list

函数

library(microbenchmark)
library(data.table)
# Arun's function
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)
}

# GSee's function
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)
}

基准测试

microbenchmark(t1 <- rbind.named.fill(l1), 
               t2 <- rbindlist(l2, fill=TRUE),
               t3 <- do.call(foo, l1),
               times=10)
#> Unit: seconds
#>                                 expr      min        lq        mean    median        uq      max neval
#> t1 <- rbind.named.fill(l1)      6.536782  7.545538   9.118771  9.304844 10.505814 11.28260    10
#> t2 <- rbindlist(l2, fill=TRUE)  5.250387  5.787712   6.910340  6.226065  7.579503 10.40524    10
#> t3 <- do.call(foo, l1)          9.590615 11.043557  13.504694 12.550535 15.364464 19.95877    10


identical(t1, data.frame(t2))
#> [1] TRUE
identical(t3, data.frame(t2))
#> [1] TRUE

最初的回答

这篇文章是由reprex包 (v0.3.0)创建于2019年08月01日。

1

将名称向量转换为单独的数据框后，您可以使用 dplyr::bind_rows

dplyr::bind_rows(lapply(x,function(y) as.data.frame(t(y),stringsAsFactors=FALSE)))

#     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

在这种情况下，我们还可以使用purrr :: map_df / purrr :: map_dfr

purrr::map_df(x, ~as.data.frame(t(.x),stringsAsFactors = FALSE))

这将产生与上面相同的输出。
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接