如何在没有强制的情况下将列表压扁？

我试图实现类似于unlist的function，除了types不强制为向量，但保留types的列表将被返回。 例如：

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

从上面的例子可以看出，扁平化应该是recursion的。 在标准R库中是否有这样的function呢，或者至less有一些其他的function可以用来轻松高效的实现呢？

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

Answer 1

有趣的非平凡的问题！

主要更新所发生的一切，我已经重写了答案，并删除了一些死胡同。 我也在不同情况下计时了各种解决scheme。

这是第一个相当简单但很慢的解决scheme：

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

rapply让你遍历一个列表并在每个叶元素上应用一个函数。 不幸的是，它的工作原理与返回的值一样。 所以我忽略了rapply的结果，而是通过执行<<-将值附加到variablesy 。

以这种方式增长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 } 

在这里，我首先找出结果长度并预先分配向量。 然后我填写值。 正如你所看到的，这个解决scheme要快得多。

这里有一个基于Reduce JoshO'Brien伟大的解决scheme的版本，但扩展，所以它处理任意深度：

 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解决scheme在深度较低的rapply速度更快，而当深度很大的时候解决scheme的速度更快！

正确性如下，这里有一些testing：

 > 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的结果…

Answer 2

对于只有很less嵌套深度的列表，可以使用Reduce()和c()来做类似下面的事情。 c()每个应用程序删除一个嵌套级别。 （有关完全一般的解决scheme，请参阅下面的编辑。）

 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 

编辑只是为了好玩，这里是@ JoshO'Brien的解决scheme的@ 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" 

Answer 3

这个怎么样？ 它构build了Josh O'Brien的解决scheme，但用recursion循环代替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") 

从我的系统输出，使用汤米的testing：

 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 

编辑：至于得到一个列表的深度，也许这样的事情会工作; 它recursion地获取每个元素的索引。

 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 

Answer 4

编辑来解决在评论中指出的缺陷。 可悲的是，这只会使效率降低。 好啊。

另一种方法，虽然我不确定它会比任何东西都更有效率@汤米build议：

 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 

Answer 5

purrr::flatten实现了。 虽然它不是recursion（由devise）。

所以应用两次应该工作：

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

这是一个recursion版本的尝试：

 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) 

Answer 6

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