Comment aplatir une liste pour une liste sans contrainte?

Question

Je suis en train de réaliser la fonctionnalité semblable à unlist, à l'exception que les types ne sont pas contraints à un vecteur, mais la liste conservés avec des types est retourné à la place. Par exemple:

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

doit retourner

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

au lieu de

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

ce qui serait retourné en unlist(list(list(NA, list("TRUE", list(FALSE), 0L)).

Comme il est vu à partir de l'exemple ci-dessus, la mise à plat doit être récursive. Est-il une fonction en standard R de la bibliothèque qui réalise cela, ou au moins une autre fonction qui peut être utilisé facilement et efficacement mettre en œuvre cette?

Mise à JOUR: je ne sais pas si c'est clair, mais non les listes ne doivent pas être aplati, c'est à dire flatten(list(1:3, list(4, 5))) doit renvoyer list(c(1, 2, 3), 4, 5).

Answer 1

Intéressant non négligeable de problème!

Mise à JOUR MAJEURE Avec tout ce qui est arrivé, j'ai réécrit la réponse et la suppression de quelques impasses. J'ai également chronométré les différentes solutions sur les différents cas.

Voici la première, plutôt simple, mais lente, de la solution:

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

rapply vous permet de parcourir une liste et d'appliquer une fonction sur chaque élément leaf. Malheureusement, il fonctionne exactement comme unlist avec les valeurs renvoyées. J'ai donc ignorer le résultat d' rapply et au lieu de cela j'ai ajouter des valeurs à la variable y en effectuant <<-.

Croissante y de cette manière n'est pas très efficace (c'est quadratique en temps). Donc si il y a plusieurs milliers d'éléments, ce sera très lent.

Une approche plus efficace est la suivante, avec les simplifications 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
}

Ici, j'ai d'abord consulter le résultat de la longueur et de pré-allouer le vecteur. Puis-je remplir les valeurs. Comme vous pouvez le voir, cette solution est beaucoup plus rapide.

Voici une version de @JoshO Brien grande solution basée sur Reduce, mais étendue, donc il gère profondeur arbitraire:

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

Maintenant que la bataille commence!

# 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

...De sorte que ce que nous observons, c'est que l' Reduce solution est plus rapide lorsque la profondeur est faible, et l' rapply solution est plus rapide lorsque la profondeur est grande!

Que de la cohérence va, voici quelques tests:

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

Difficile de ce résultat est souhaitée, mais je me penche vers le résultat de l' flatten2...

Answer 2

Pour les listes qui ne sont qu'à quelques imbrications de profondeur, vous pouvez utiliser Reduce() et c() de faire quelque chose comme ce qui suit. Chaque demande d' c() supprime un niveau d'imbrication. (Pour solution générale, voir les Modifications ci-dessous.)

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 Juste pour le fun, voici une version de @Tommy version de @JoshO Brien solution qui fonctionne déjà pour les listes horizontales. MODIFIER Maintenant @Tommy résolu ce problème, mais d'une manière plus propre. Je vais quitter cette version en place.

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 3

Comment à ce sujet? Il repose sur Josh O'Brien est une solution, mais ne la récursivité avec un while boucle au lieu d'utiliser unlist avec 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
}

Garder la ligne commentée en donne des résultats comme ceci (qui Tommy préfère, et moi aussi, d'ailleurs).

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

Sortie de mon système, à l'aide de Tommy tests:

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: Comme pour obtenir la profondeur d'une liste, peut-être quelque chose de ce genre; il obtient l'indice de chaque élément de manière récursive.

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

Ce n'est pas super rapide, mais il semble bien fonctionner.

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

Je l'avais imaginé qu'il soit utilisé de cette façon:

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

Mais vous pouvez également obtenir un décompte du nombre de nœuds à chaque profondeur.

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

Édité à l'adresse d'une faille de sécurité a souligné dans les commentaires. Malheureusement, il ne fait que le rendre moins efficace. Ah bien.

Une autre approche, bien que je ne suis pas sûr que ce sera plus efficace que n'importe quoi @Tommy a suggéré:

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 5

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