如何将列表平铺成一个不需要强制转换的列表?

54

我想实现类似于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'))) 应该返回什么? - Tommy
list(c(1, 2, 3), c(1, 2, 3), 'foo')。解释:1:3 不是一个列表,因此不应该被展平。 - eold
purrr::flatten 看起来是当前最佳实践(根据 @Aurèle 的回答) - geotheory
7个回答

33

有趣的非平凡问题!

重要更新 针对发生的所有事情,我已经重新编写了答案并删除了一些死胡同。我还计时了不同情况下的各种解决方案。

这是第一个相当简单但速度较慢的解决方案:

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
}

首先,我找出结果的长度并预先分配向量。然后,我填写值。

正如您所看到的,这个解决方案要快得多。

这是@JoshO'Brien伟大解决方案的一个版本,基于Reduce,但扩展以处理任意深度:

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})。它与您的更新解决方案一样快。 - Joshua Ulrich
@Tommy -- 我刚刚偷了你最新的flatten版本,并添加了一行代码来解决你指出的特殊情况。希望你不介意,随时可以根据自己的需求进行编辑。谢谢! - Josh O'Brien
+1 -- 不知道为什么我之前没有给这篇文章点赞。这应该让你的出色比较得到最大的关注度。此外,我绝对更喜欢flatten2的输出结果。 - Josh O'Brien
这些方法中的一个问题是,NULL元素会被静默丢弃。 - Jeroen Ooms
@Tommy,非常抱歉之前在我的包函数rlist::list.flatten中遗漏了对你的flatten2实现的归属。你应该得到完全的功劳,链接为https://github.com/renkun-ken/rlist/blob/master/R/list.flatten.R,同时感谢你的想法! - Kun Ren
显示剩余3条评论

14

对于只有几层嵌套的列表,您可以使用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"

@leden -- 你可以使用!any(sapply(L, class)=="list")来测试一个列表是否是扁平化的,如果是完全扁平化的列表,它将返回TRUE - Josh O'Brien
@leden - 我添加了一个变量来实现这个功能。 - Tommy
@JoshO'Brien - 好嘞,我让你发了一个更好的解决方案,是吧?;-) 一个建议:只需在 Reduce 之前移动 if 条件并跳过 x <- list(x) - Tommy
1
@JoshO'Brien,!any(vapply(L, is.list, logical(1)))会更好吧? - hadley
@hadley -- 你是在提到你上面第四个评论中的评论,我建议使用!any(sapply...,对吧?(在帖子正文中,我确实使用了你(和Tommy)建议的更好的习惯用语)。 - Josh O'Brien
显示剩余4条评论

12

这个怎么样?它基于Josh O'Brien的解决方案,但使用while循环进行递归,而不是使用带有recursive = FALSEunlist函数。

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 

@JoshO'Brien:请看修改后的深度想法。虽然它能工作,但并不是很好。有什么建议吗? - Aaron left Stack Overflow
嗨,亚伦。不错的解决方案,但我同意它并不理想。找到总是比最坏情况下的flatten4时间更快的东西会很好。我的两个想法是:“我想知道系统发育学家是否已经在某个软件包中有类似的东西”,以及“处理解析器的人可以轻松做到这一点”。 - Josh O'Brien
谢谢。我认为这是目前最好的解决方案。 - eold
+1. 这解决了另一个问题:其他函数也会取消列表向量,而这个只会列出。 (当向量和列表在深度=2时,Tommy的解决方案不会这样做) - Michael Schubert
如果您将flatten4中的两个is.list实例更改为function(x) !is.data.frame(x) & is.list(x),那么它也适用于数据框,而目前没有任何答案可以做到这一点。flatten4(list(1:3, list(1:3, 'foo'), TRUE, 'hi', list(head(mtcars), list(tail(mtcars))))) 就像梦想一样运行。 - rawr
显示剩余2条评论

5

编辑以解决评论中指出的缺陷。不幸的是,这使其效率更低。嗯。

另一种方法,虽然我不确定它是否比@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

是的,速度慢了一点(大约3倍),但对于这个有趣的解决方案还是要点赞! - Tommy
哦,我在 flatten( list(1:3, list(1:3, 'foo')) ) 失败了。 - Tommy
@Tommy 很好的发现。我进行了编辑以解决问题,但不幸的是,这将使性能比之前更差。 - joran

3

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)

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

0

您也可以在rrapply包中使用rrapply(基础rapply的扩展版本),通过设置how = "flatten"

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回答中flatten2flatten3函数在两个大型嵌套列表上的一些基准计时:

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

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接