tenga - ¿Cómo aplanar una lista a una lista sin coacción?

crear lista vacia python

Question

Estoy tratando de lograr la funcionalidad similar a unlist, con la excepción de que los tipos no se fuerzan a un vector, pero la lista con tipos preservados se devuelve en su lugar. Por ejemplo:

flatten(list(NA, list("TRUE", list(FALSE), 0L))

debería regresar

list(NA, "TRUE", FALSE, 0L)

en lugar de

c(NA, "TRUE", "FALSE", "0")

que sería devuelto por unlist(list(list(NA, list("TRUE", list(FALSE), 0L)) .

Como se ve en el ejemplo anterior, el aplanamiento debe ser recursivo. ¿Hay alguna función en la biblioteca R estándar que logre esto, o al menos alguna otra función que pueda usarse para implementar esto fácil y eficientemente?

ACTUALIZACIÓN : no sé si está claro de lo anterior, pero las listas no deben aplanarse, es decir, flatten(list(1:3, list(4, 5))) debería devolver la list(c(1, 2, 3), 4, 5) .

Answer 1

¿Qué tal esto? Se basa en la solución de Josh O''Brien, pero realiza la recursión con un ciclo while en lugar de usar unlist con 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
}

Mantener la línea comentada da resultados como este (que Tommy prefiere, y yo también).

> x <- list(1:3, list(1:3, ''foo''))
> dput(flatten4(x))
list(1:3, 1:3, "foo")

Salida de mi sistema, usando las pruebas de 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

EDITAR: en cuanto a obtener la profundidad de una lista, tal vez algo así podría funcionar; obtiene el índice para cada elemento recursivamente.

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))
}

No es súper rápido, pero parece funcionar bien.

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

Me imaginaba que se usa de esta manera:

> x[[ d[[5]] ]]
[1] "leaf"
> x[[ d[[6]] ]]
[1] 1

Pero también podría obtener un recuento de cuántos nodos hay en cada profundidad.

> 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 2

Interesante problema no trivial!

ACTUALIZACIÓN MAYOR Con todo lo que sucedió, reescribí la respuesta y eliminé algunos callejones sin salida. También cronometré las diversas soluciones en diferentes casos.

Esta es la primera solución, bastante simple pero lenta:

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

rapply te permite recorrer una lista y aplicar una función en cada elemento de hoja. Lamentablemente, funciona exactamente como unlist con los valores devueltos. Por lo tanto, ignoro el resultado de la rapply y en su lugar rapply valores a la variable y haciendo <<- .

Crecer de esta manera no es muy eficiente (es cuadrático en el tiempo). Entonces, si hay muchos miles de elementos, esto será muy lento.

Un enfoque más eficiente es el siguiente, con simplificaciones de @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
}

Aquí primero descubro la longitud del resultado y preasigne el vector. Luego llene los valores. Como puede ver, esta solución es mucho más rápida.

Aquí hay una versión de la gran solución de @ JoshO''Brien basada en Reduce , pero extendida para que maneje la profundidad arbitraria:

flatten3 <- function(x) {
repeat {
if(!any(vapply(x, is.list, logical(1)))) return(x)
x <- Reduce(c, x)
}
}

¡Ahora comienza la batalla!

# 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

... Entonces, lo que observamos es que la solución Reduce es más rápida cuando la profundidad es baja, y la solución de aplicación es más rápida cuando la profundidad es grande.

Como es correcto, aquí hay algunas pruebas:

> 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")

Incierto qué resultado se desea, pero me inclino hacia el resultado de flatten2 ...

Answer 3

Para las listas que tienen solo unos pocos nidos de profundidad, puede usar Reduce() c() para hacer algo como lo siguiente. Cada aplicación de c() elimina un nivel de anidación. (Para una solución completamente general, vea los EDIT a continuación).

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

EDITAR Solo por diversión, aquí hay una versión de @ Tommy de la solución de @ JoshO''Brien que funciona para listas que ya son planas. MÁS EDITAR Ahora @ Tommy también resolvió ese problema, pero de una manera más limpia. Dejaré esta versión en su lugar.

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 4

purrr::flatten logra eso. Aunque no es recursivo (por diseño).

Entonces aplicarlo dos veces debería funcionar:

library(purrr)
l <- list(NA, list("TRUE", list(FALSE), 0L))
flatten(flatten(l))

Aquí hay un intento en una versión recursiva:

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 5

Editado para abordar un error señalado en los comentarios. Lamentablemente, solo lo hace aún menos eficiente. Ah bueno.

Otro enfoque, aunque no estoy seguro de que sea más eficiente que cualquier cosa, @Tommy ha sugerido:

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 6

hack_list <- function(.list) {
.list[[''_hack'']] <- function() NULL
.list <- unlist(.list)
.list$`_hack` <- NULL
.list
}