r unlist用法



如何在沒有強制的情況下將列表展平到列表? (4)

我試圖實現類似於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))返回unlist(list(list(NA, list("TRUE", list(FALSE), 0L))

從上面的例子中可以看出,扁平化應該是遞歸的。 標準R庫中是否有一個功能可以實現這一功能,或者至少還有一些其他功能可用於輕鬆有效地實現這一功能?

更新 :我不知道從上面是否清楚,但非列表不應該被flatten(list(1:3, list(4, 5)))平,即flatten(list(1:3, list(4, 5)))應該返回list(c(1, 2, 3), 4, 5)


Answer #1

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)

Answer #2

編輯以解決評論中指出的缺陷。 可悲的是,它只會降低效率。 呃,好吧。

另一種方法,雖然我不確定它會比@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

Answer #3

有趣的非平凡問題!

主要更新隨著所有這一切的發生,我重寫了答案並刪除了一些死胡同。 我還針對不同的案例計算了各種解決方案。

這是第一個相當簡單但又緩慢的解決方案:

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

rapply允許您遍歷列表並在每個葉元素上應用函數。 不幸的是,它與返回值完全一樣。 所以我忽略了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解決方案會更快,而當深度很大時,解決方案會更快!

正確性如下,這裡有一些測試:

> 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 #4

這個怎麼樣? 它構建了Josh O'Brien的解決方案,但使用while循環進行遞歸, while不是使用帶有recursive=FALSE unlist

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 




type-coercion