如何在没有强制的情况下将列表展平为列表？答案

【问题标题】：How to flatten a list to a list without coercion?如何在没有强制的情况下将列表展平为列表？
【发布时间】：2011-12-29 16:39:21
【问题描述】：

我正在尝试实现类似于 unlist 的功能，但类型不会被强制转换为向量，而是返回具有保留类型的列表。例如：

flatten(list(NA, list("TRUE", list(FALSE), 0L))

应该返回

list(NA, "TRUE", FALSE, 0L)

而不是

c(NA, "TRUE", "FALSE", "0")

这将由unlist(list(list(NA, list("TRUE", list(FALSE), 0L)) 返回。

从上面的例子可以看出，展平应该是递归的。标准 R 库中是否有一个函数可以实现这一点，或者至少有一些其他函数可以用来轻松有效地实现这一点？

更新：我不知道从上面是否清楚，但非列表不应该被展平，即flatten(list(1:3, list(4, 5)))应该返回list(c(1, 2, 3), 4, 5)。

【问题讨论】：

flatten( list(1:3, list(1:3, 'foo')) ) 应该返回什么？
list(c(1, 2, 3), c(1, 2, 3), 'foo')。解释：1:3 不是一个列表，所以它不应该被展平。
purrr::flatten 看起来像当前的最佳实践（根据@Aurèle 的回答）

标签： list r standard-library flatten type-coercion

【解决方案1】：

您还可以通过设置how = "flatten"，在rrapply-package（base-rapply的扩展版）中使用rrapply：

library(rrapply)

rrapply(list(NA, list("TRUE", list(FALSE), 0L)), how = "flatten")
#> [[1]]
#> [1] NA
#> 
#> [[2]]
#> [1] "TRUE"
#> 
#> [[3]]
#> [1] FALSE
#> 
#> [[4]]
#> [1] 0

计算时间

以下是 Tommy 对两个大型嵌套列表的响应中的 flatten2 和 flatten3 函数的一些基准时间：

flatten2 <- function(x) {
  len <- sum(rapply(x, function(x) 1L))
  y <- vector('list', len)
  i <- 0L
  rapply(x, function(x) { i <<- i+1L; y[[i]] <<- x })
  y
}

flatten3 <- function(x) {
  repeat {
    if(!any(vapply(x, is.list, logical(1)))) return(x)
    x <- Reduce(c, x)
  }
}

## large deeply nested list (1E6 elements, 6 layers)
deep_list <- rrapply(replicate(10, 1, simplify = F), classes = c("list", "numeric"), condition = function(x, .xpos) length(.xpos) < 6, f = function(x) replicate(10, 1, simplify = F), how = "recurse")

system.time(flatten2(deep_list))
#>    user  system elapsed 
#>   1.715   0.012   1.727
## system.time(flatten3(deep_list)), not run takes more than 10 minutes
system.time(rrapply(deep_list, how = "flatten"))
#>    user  system elapsed 
#>   0.105   0.016   0.121

## large shallow nested list (1E6 elements, 2 layers)
shallow_list <- lapply(replicate(1000, 1, simplify = F), function(x) replicate(1000, 1, simplify = F))

system.time(flatten2(shallow_list))
#>    user  system elapsed 
#>   1.308   0.040   1.348
system.time(flatten3(shallow_list))
#>    user  system elapsed 
#>   5.246   0.012   5.259
system.time(rrapply(shallow_list, how = "flatten"))
#>    user  system elapsed 
#>    0.09    0.00    0.09

【讨论】：

【解决方案2】：

purrr::flatten 实现了这一点。虽然它不是递归的（按设计）。

所以应用它两次应该可以工作：

library(purrr)
l <- list(NA, list("TRUE", list(FALSE), 0L))
flatten(flatten(l))

这是一个递归版本的尝试：

flatten_recursive <- function(x) {
  stopifnot(is.list(x))
  if (any(vapply(x, is.list, logical(1)))) Recall(purrr::flatten(x)) else x
}
flatten_recursive(l)

【讨论】：

【解决方案3】：

hack_list <- function(.list) {
  .list[['_hack']] <- function() NULL
  .list <- unlist(.list)
  .list$`_hack` <- NULL
  .list
}

【讨论】：

【解决方案4】：

这个怎么样？它以 Josh O'Brien 的解决方案为基础，但使用 while 循环而不是使用 unlist 和 recursive=FALSE 进行递归。

flatten4 <- function(x) {
  while(any(vapply(x, is.list, logical(1)))) { 
    # this next line gives behavior like Tommy's answer; 
    # removing it gives behavior like Josh's
    x <- lapply(x, function(x) if(is.list(x)) x else list(x))
    x <- unlist(x, recursive=FALSE) 
  }
  x
}

保留注释行会得到这样的结果（Tommy 更喜欢，我也喜欢）。

> x <- list(1:3, list(1:3, 'foo'))
> dput(flatten4(x))
list(1:3, 1:3, "foo")

我系统的输出，使用 Tommy 的测试：

dput(flatten4(foo))
#list(NA, "TRUE", FALSE, 0L)

# Time on a long 
x <- as.list(1:1e5)
system.time( x2 <- flatten2(x) )  # 0.48 secs
system.time( x3 <- flatten3(x) )  # 0.07 secs
system.time( x4 <- flatten4(x) )  # 0.07 secs
identical(x2, x4) # TRUE
identical(x3, x4) # TRUE

# Time on a huge deep list
x <-'leaf'; for(i in 1:11) { x <- list(left=x, right=x, value=i) }
system.time( x2 <- flatten2(x) )  # 0.05 secs
system.time( x3 <- flatten3(x) )  # 1.45 secs
system.time( x4 <- flatten4(x) )  # 0.03 secs
identical(x2, unname(x4)) # TRUE
identical(unname(x3), unname(x4)) # TRUE

编辑：至于获得列表的深度，也许这样的事情会起作用；它递归地获取每个元素的索引。

depth <- function(x) {
  foo <- function(x, i=NULL) {
    if(is.list(x)) { lapply(seq_along(x), function(xi) foo(x[[xi]], c(i,xi))) }
    else { i }
  }
  flatten4(foo(x))
}

它不是超级快，但似乎工作正常。

x <- as.list(1:1e5)
system.time(d <- depth(x)) # 0.327 s

x <-'leaf'; for(i in 1:11) { x <- list(left=x, right=x, value=i) }
system.time(d <- depth(x)) # 0.041s

我以为它会被这样使用：

> x[[ d[[5]] ]]
[1] "leaf"
> x[[ d[[6]] ]]
[1] 1

但您也可以计算每个深度有多少节点。

> table(sapply(d, length))

   1    2    3    4    5    6    7    8    9   10   11 
   1    2    4    8   16   32   64  128  256  512 3072

【讨论】：

+1 用于继续扩展此功能。现在，如果我们有办法快速评估列表的深度……有什么想法吗？
@JoshO'Brien：请参阅编辑以了解深度想法。它有效，但不是很好。有什么建议吗？
嗨亚伦。不错的解决方案，但我同意这并不理想。找到总是比最坏情况flatten4 计时更快的东西会很好。我的两个想法是：“我想知道系统发育学的人是否已经在一个包中拥有类似的东西”，以及“使用解析器的人可以很快做到这一点”。
我用deparse(L) 产生的字符串演奏了几分钟，即"list(NA, list(\"TRUE\", list(FALSE), 0L))"，但我意识到我的头绪/没有时间。我的基本想法是运行一次，将子字符串list( 的每次出现都计数为+1，并将每个匹配的右括号) 计数为-1。 max(cumsum()) 或类似的东西会让你获得最大的深度。似乎是一种合理的方法，可能需要一个可怕的正则表达式来实现！对于我们中的一个人来说，这可能是一个很好的 SO 问题......
谢谢。我认为这是迄今为止最好的解决方案。

【解决方案5】：

已编辑以解决 cmets 中指出的缺陷。可悲的是，它只会降低效率。嗯嗯。

另一种方法，虽然我不确定它是否会比@Tommy 建议的任何方法更有效：

l <- list(NA, list("TRUE", list(FALSE), 0L))

flatten <- function(x){
    obj <- rapply(x,identity,how = "unlist")
    cl <- rapply(x,class,how = "unlist")
    len <- rapply(x,length,how = "unlist")
    cl <- rep(cl,times = len)
    mapply(function(obj,cl){rs <- as(obj,cl); rs}, obj, cl, 
        SIMPLIFY = FALSE, USE.NAMES = FALSE)
}

> flatten(l)
[[1]]
[1] NA

[[2]]
[1] "TRUE"

[[3]]
[1] FALSE

[[4]]
[1] 0

【讨论】：

是的，它有点慢（~3x），但有趣的解决方案 +1！
嗯。我失败了flatten( list(1:3, list(1:3, 'foo')) )
@Tommy 很好。我进行了编辑以解决该问题，但遗憾的是，这会使性能比以前更差。

【解决方案6】：

有趣的不平凡的问题！

重大更新 发生了这一切后，我重写了答案并消除了一些死胡同。我还针对不同情况对各种解决方案进行了计时。

这是第一个相当简单但缓慢的解决方案：

flatten1 <- function(x) {
  y <- list()
  rapply(x, function(x) y <<- c(y,x))
  y
}

rapply 允许您遍历一个列表并在每个叶元素上应用一个函数。不幸的是，它与 unlist 的返回值完全一样。所以我忽略了来自rapply 的结果，而是通过执行<<- 将值附加到变量y。

以这种方式增长y 效率不高（它是时间的二次方）。因此，如果有数千个元素，这将非常慢。

以下是一种更有效的方法，经过@JoshuaUlrich 的简化：

flatten2 <- function(x) {
  len <- sum(rapply(x, function(x) 1L))
  y <- vector('list', len)
  i <- 0L
  rapply(x, function(x) { i <<- i+1L; y[[i]] <<- x })
  y
}

这里我先找出结果长度并预先分配向量。然后我填写值。如您所见，此解决方案要快得多。

这是基于Reduce 的@JoshO'Brien 解决方案的一个版本，但经过扩展，可以处理任意深度：

flatten3 <- function(x) {
  repeat {
    if(!any(vapply(x, is.list, logical(1)))) return(x)
    x <- Reduce(c, x)
  }
}

现在开始战斗吧！

# Check correctness on original problem 
x <- list(NA, list("TRUE", list(FALSE), 0L))
dput( flatten1(x) )
#list(NA, "TRUE", FALSE, 0L)
dput( flatten2(x) )
#list(NA, "TRUE", FALSE, 0L)
dput( flatten3(x) )
#list(NA_character_, "TRUE", FALSE, 0L)

# Time on a huge flat list
x <- as.list(1:1e5)
#system.time( flatten1(x) )  # Long time
system.time( flatten2(x) )  # 0.39 secs
system.time( flatten3(x) )  # 0.04 secs

# Time on a huge deep list
x <-'leaf'; for(i in 1:11) { x <- list(left=x, right=x, value=i) }
#system.time( flatten1(x) ) # Long time
system.time( flatten2(x) )  # 0.05 secs
system.time( flatten3(x) )  # 1.28 secs

...所以我们观察到，Reduce 解在深度低时更快，rapply 解在深度大时更快！

根据正确性，这里有一些测试：

> dput(flatten1( list(1:3, list(1:3, 'foo')) ))
list(1L, 2L, 3L, 1L, 2L, 3L, "foo")
> dput(flatten2( list(1:3, list(1:3, 'foo')) ))
list(1:3, 1:3, "foo")
> dput(flatten3( list(1:3, list(1:3, 'foo')) ))
list(1L, 2L, 3L, 1:3, "foo")

不清楚需要什么结果，但我倾向于flatten2的结果...

【讨论】：

我想出了与您的更新类似的东西，但可能不那么复杂：y <- vector("list", sum(rapply(x,length))); i <- 1 然后是rapply(x, function(z) {y[[i]] <<- z; i <<- i+1})。它与您更新的解决方案一样快。
愚蠢的我，是的，这更容易 - 我不认为y[[i]] <<- z 会起作用，所以我什至没有尝试！
@Tommy -- 我刚刚偷了你最新版本的 flatten，添加了一行来处理你确定的角落案例。希望您不介意，并随时相应地编辑您自己的版本。谢谢！
+1 -- 不知道我怎么还没有投票给这篇文章。这应该使您处于领先地位，以便您出色的比较获得最大的知名度。另外，我绝对更喜欢flatten2 的输出。
谢谢。你可以消除flatten1。它不仅是最慢的，而且它也不保留非列表（即 1:5 变平而它不应该变平）。

【解决方案7】：

对于只有几个嵌套深度的列表，您可以使用Reduce() 和c() 执行以下操作。 c() 的每个应用程序都会删除一层嵌套。 （有关完全通用的解决方案，请参阅下面的编辑。）

L <- (list(NA, list("TRUE", list(FALSE), 0L)))
Reduce(c, Reduce(c, L))
[[1]]
[1] NA

[[2]]
[1] "TRUE"

[[3]]
[1] FALSE

[[4]]
[1] 0



# TIMING TEST
x <- as.list(1:4e3)
system.time(flatten(x))   # Using the improved version    
# user  system elapsed 
# 0.14    0.00    0.13 
system.time(Reduce(c, x))
# user  system elapsed 
# 0.04    0.00    0.03

编辑只是为了好玩，这里是@Tommy 版本的@JoshO'Brien 解决方案的一个版本，它确实可以用于已经平坦的列表。 进一步编辑 现在@Tommy 也解决了这个问题，但方式更简洁。我将保留此版本。

flatten <- function(x) {
    x <- list(x)
    repeat {
        x <- Reduce(c, x)
        if(!any(vapply(x, is.list, logical(1)))) return(x)
    }
}

flatten(list(3, TRUE, 'foo'))
# [[1]]
# [1] 3
# 
# [[2]]
# [1] TRUE
# 
# [[3]]
# [1] "foo"

【讨论】：

+1 很好地使用Reduce！ ...但它似乎无法处理flatten(list(3, TRUE, 'foo'))
我更关心递归实现它，以便为非恒定深度列表工作。有没有一个函数可以用来检测列表是否被展平？
@leden -- 您可以使用!any(sapply(L, class)=="list") 测试列表是否平坦，对于完全平坦的列表，它将评估为TRUE。
@leden - 我添加了一个变体。
@JoshO'Brien !any(vapply(L, is.list, logical(1))) 会不会更好？