Как сгладить список в список без принуждения?

Я пытаюсь достичь функциональности, подобной 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 Solutions collect form web for “Как сгладить список в список без принуждения?”

Интересная нетривиальная проблема!

ОСНОВНОЕ ОБНОВЛЕНИЕ Со всем, что случилось, я переписал ответ и удалил некоторые тупики. Я также приурочил различные решения по различным случаям.

Вот первое, довольно простое, но медленное решение:

 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 происходит быстрее, когда глубина 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 , но я склоняюсь к результату от flatten2 ...

Для списков, которые содержат всего несколько гнезд, вы можете использовать функции Reduce() и c() чтобы сделать что-то вроде следующего. Каждое приложение c() удаляет один уровень вложенности. (Полностью общее решение см. В разделе EDIT ниже).

 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's @ JoshO'Brien, которая работает для уже плоских списков. ДАЛЬНЕЙШЕЕ ИЗМЕНИТЬ Теперь @ Томми решил эту проблему, но в чистом виде. Я оставлю эту версию на месте.

 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" 

Как насчет этого? Он строит решение Джоша О’Брайена, но recursion с циклом 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 } 
Давайте будем гением компьютера.