Как свести список к списку без принуждения?
Я пытаюсь достичь функциональности, подобной 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)
.
6 ответов
интересная нетривиальная проблема!
ОСНОВНОЕ ОБНОВЛЕНИЕ со всем, что произошло, я переписал ответ и удалил некоторые тупики. Я также приурочил различные решения по разным делам.
вот первое, довольно простое, но медленное решение:
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 Брайен, основанные на 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
...
для списков, которые только несколько вложений глубоко, вы можете использовать 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
редактировать просто для удовольствия, вот версия версия @Томми решение @JoshO Брайен, что работает для уже плоских списков. ДАЛЬНЕЙШЕЕ РЕДАКТИРОВАНИЕ теперь @Томми решил эту проблему, как Ну, но в более чистом виде. Я оставлю эту версию на месте.
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"
как насчет этого? Он строит решение Джоша О'Брайена, но делает рекурсию с помощью 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
}
сохранение прокомментированной строки дает такие результаты (которые Томми предпочитает, и я тоже, если на то пошло).
> x <- list(1:3, list(1:3, 'foo'))
> dput(flatten4(x))
list(1:3, 1:3, "foo")
вывод из моей системы, используя тесты Томми:
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
EDIT: что касается получения глубины списка, возможно, что-то вроде этого будет работать; он получает индекс для каждого элемент рекурсивно.
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
добивается этого. Хотя это не рекурсивно (по дизайну).
поэтому применение его дважды должно работать:
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
}