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

4

7 に答える 7

32

興味深い重要な問題！

メジャーアップデートすべてが起こったので、私は答えを書き直し、いくつかの行き止まりを取り除きました。また、さまざまなケースでさまざまなソリューションのタイミングを調整しました。

これが最初の、かなり単純ですが遅い解決策です：

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どのような結果が望まれるかは不明ですが、私は...からの結果に傾いています。

于 2011-11-15T16:49:31.043 に答える
14

数個のネストの深さしかないリストの場合、 and を使用Reduce()しc()て次のようなことを行うことができます。を適用するたびに、c()1 レベルのネストが削除されます。(完全に一般的な解決策については、以下の編集を参照してください。)

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'sもその問題を解決しましたが、よりクリーンな方法で。このバージョンはそのままにしておきます。

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"
于 2011-11-15T17:26:06.793 に答える
12

これはどう？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
于 2011-11-15T20:49:25.390 に答える
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
于 2011-11-15T17:22:28.223 に答える