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

Question

我试图实现类似于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).

Answer 1

有趣的非平凡问题!

主要更新随着所有这一切的发生,我重写了答案并删除了一些死胡同.我还针对不同的案例计算了各种解决方案.

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

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

Answer 2

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

Answer 3

这个怎么样？它建立过乔希奥布莱恩的解决方案,但不会递归与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 

Answer 4

编辑以解决评论中指出的缺陷。可悲的是，这只会让效率变得更低。呃，好吧。

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