リストを強制せずにリストにフラット化する方法は？
型がベクトルに強制変換されないことを除いて、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ライブラリの関数、またはこれを簡単かつ効率的に実装するために使用できる少なくともいくつかの他の関数はありますか？
[〜＃〜] update [〜＃〜]：上記から明らかかどうかはわかりませんが、非リストをフラット化しないでください。つまり、flatten(list(1:3, list(4, 5)))をフラット化する必要があります。 list(c(1, 2, 3), 4, 5)を返します。
興味深い重要な問題！
メジャーアップデートすべてが起こったので、私は答えを書き直し、いくつかの行き止まりを削除しました。また、さまざまなケースでさまざまなソリューションの時間を計りました。
これが最初の、かなり単純ですが遅い解決策です：
flatten1 <- function(x) {
y <- list()
rapply(x, function(x) y <<- c(y,x))
y
}
rapplyを使用すると、リストを走査して、各リーフ要素に関数を適用できます。残念ながら、戻り値はunlistとまったく同じように機能します。したがって、rapplyの結果を無視し、代わりに<<-を実行して変数yに値を追加します。
この方法でyを成長させることは、あまり効率的ではありません（時間的に2次式です）。したがって、何千もの要素がある場合、これは非常に遅くなります。
より効率的なアプローチは次のとおりですが、@ 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ソリューションが高速であり、深さが大きい場合は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 ..からの結果に傾倒しています。
ネストの深さが数個しかないリストの場合は、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
[〜＃〜] edit [〜＃〜]楽しみのために、これは@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"
これはどう？ Josh O'Brienのソリューションを基に構築されていますが、recursive=FALSEでwhileを使用する代わりに、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
コメントで指摘された欠陥に対処するために編集されました。残念ながら、それはさらに効率を低下させます。まあ。
別のアプローチですが、@ 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
purrr::flattenそれを達成します。再帰的ではありませんが（設計による）。
したがって、2回適用すると機能するはずです。
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)
hack_list <- function(.list) {
.list[['_hack']] <- function() NULL
.list <- unlist(.list)
.list$`_hack` <- NULL
.list
}