Свести вложенный список списков с переменным количеством элементов во фрейм данных

У меня есть вложенный список списков, который я хотел бы объединить в фрейм данных с переменными идентификатора, чтобы я знал, из каких элементов списка (и элементов подсписка) каждый пришел.

> str(gc_all)
List of 3
$ 1: num [1:102, 1:2] -74 -73.5 -73 -72.5 -71.9 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : NULL
.. ..$ : chr [1:2] "lon" "lat"
$ 2: num [1:102, 1:2] -74 -73.3 -72.5 -71.8 -71 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : NULL
.. ..$ : chr [1:2] "lon" "lat"
$ 3:List of 2
..$ : num [1:37, 1:2] -74 -74.4 -74.8 -75.3 -75.8 ...
.. ..- attr(*, "dimnames")=List of 2
.. .. ..$ : NULL
.. .. ..$ : chr [1:2] "lon" "lat"
..$ : num [1:65, 1:2] 180 169 163 158 154 ...
.. ..- attr(*, "dimnames")=List of 2
.. .. ..$ : NULL
.. .. ..$ : chr [1:2] "lon" "lat"

Раньше я использовал plyr::ldply(mylist, rbind) для выравнивания списков, но, похоже, у меня возникли проблемы из-за переменной длины списка: некоторые элементы списка содержат только один фрейм данных, а другие содержат список из двух фреймов данных.

Я нашел неуклюжее решение с использованием двух lapply и ifelse, например:

# sample latitude-longitude data
df <- data.frame(source_lat = rep(40.7128, 3),
                 source_lon = rep(-74.0059, 3),
                 dest_lat = c(55.7982, 41.0082, -7.2575),
                 dest_lon = c(37.968, 28.9784, 112.7521),
                 id = 1:3)

# split into list
gc_list <- split(df, df$id)

# get great circles between lat-lon for each id; multiple list elements are outputted when the great circle crosses the dateline
gc_all <- lapply(gc_list, function(x) {
  geosphere::gcIntermediate(x[, c("source_lon", "source_lat")],
                 x[, c("dest_lon", "dest_lat")],
                 n = 100, addStartEnd=TRUE, breakAtDateLine=TRUE)
})

gc_fortified <- lapply(1:length(gc_all), function(i) {
  if(class(gc_all[[i]]) == "list") {
    lapply(1:length(gc_all[[i]]), function(j) {
      data.frame(gc_all[[i]][[j]], id = i, section = j)
    }) %>%
      plyr::rbind.fill()
  } else {
    data.frame(gc_all[[i]], id = i, section = 1)
  }
}) %>%
  plyr::rbind.fill()

Но я чувствую, что должно быть более элегантное решение, которое работает как однострочник, например. dput, data.table?

Вот как я ожидаю, что результат будет выглядеть так:

> gc_fortified %>% 
    group_by(id, section) %>%
    slice(1)

lon      lat    id section
<dbl>    <dbl> <int>   <dbl>
1 -74.0059 40.71280     1       1
2 -74.0059 40.71280     2       1
3 -74.0059 40.71280     3       1
4 180.0000 79.70115     3       2

person jogall    schedule 31.01.2018    source источник
comment
как насчет do.call("rbind.fill", lapply(gc_all, rbind.fill)) ? Предполагая, что ваш список работает всего на два уровня в глубину.   -  person RolandASc    schedule 31.01.2018
comment
Где ваши образцы данных, которые можно использовать для тестирования? Каков ваш ожидаемый результат?   -  person 989    schedule 31.01.2018
comment
@RolandASc Я пробовал это, но возвращает ошибку arguments imply differing number of rows   -  person jogall    schedule 31.01.2018
comment
Пример данных @989 уже включен в вопрос. gc_fortified содержит ожидаемый результат, но я все равно добавил его образец в вопрос.   -  person jogall    schedule 31.01.2018
comment
вы правы, я не знал, что у вас есть матрицы. тогда должно быть do.call("rbind.fill.matrix", lapply(gc_all, rbind.fill.matrix))   -  person RolandASc    schedule 31.01.2018
comment
do.call(plyr::rbind.fill.matrix, lapply(gc_all, plyr::rbind.fill.matrix)) похоже работает, но вы не сохраняете идентификаторы элементов.   -  person Moody_Mudskipper    schedule 31.01.2018


Ответы (3)


Сначала нужно переработать структуру списка, чтобы он стал обычным списком списков, затем мы применяем map_dfr два раза, используя параметр .id.

library(purrr)
gc_all_df  <- map(map_if(gc_all,~class(.x)=="matrix",list),~map(.x,as.data.frame))
map_dfr(gc_all_df,~map_dfr(.x,identity,.id="id2"),identity,.id="id1")
person Moody_Mudskipper    schedule 31.01.2018
comment
В точку, спасибо! Я давно собирался выучить purrrrrrrr, и это закрывает сделку - person jogall; 31.01.2018
comment
Один момент заметил, функцию лучше вызывать напрямую без загрузки пакета (т.е. purrr::map_dfr) из-за конфликта с ggplot2 (видимо это довольно распространенная вещь) - person jogall; 31.01.2018
comment
Это всегда безопаснее, но для функций tidyverse довольно удобно загружать пакет... для большего удовольствия от муррр вы можете проверить мой первоначальный ответ (см. историю редактирования), где я использовал purrr::partial и purrr::lift_dl на dplyr::bind_rows. Это действительно крутые функции, которые можно комбинировать с map вызовами. - person Moody_Mudskipper; 01.02.2018

Я думаю, что предпочитаю уже показанное рекурсивное решение, но это один оператор формы do.call("rbind", ...), как и было запрошено, если вы подставите L и add_n_s в последнюю строку. Я сохранил их здесь отдельно только для ясности.

Я оставил результат в виде матрицы, поскольку результат полностью числовой, и я подозреваю, что дело не в том, что вы предпочитаете фреймы данных, а в том, что rbind.fill работает с ними, и это было то, что вы использовали. Замените cbind в функции add_n_s на data.frame, если вы предпочитаете результат фрейма данных.

Никакие пакеты не используются, и решение не использует никакого индексирования.

Здесь gc_all преобразуется в L, что то же самое, за исключением того, что это список списков, а не список из смеси матриц и списков. add_n_s берет элемент L и добавляет к нему столбцы n и s. Наконец, мы наносим add_n_s на L и сглаживаем.

Обратите внимание, что если бы вход был списком списков, то L было бы равно gc_all, и первая строка не понадобилась бы.

L <- lapply(gc_all, function(x) if (is.list(x)) x else list(x))

add_n_s <- function(x, n) Map(cbind, x, n = n, s = seq_along(x))
do.call("rbind", do.call("c", Map(add_n_s, L, seq_along(gc_all))))

Обновление исправлено.

person G. Grothendieck    schedule 31.01.2018
comment
Спасибо за ответ, я принял решение purrr, поскольку оно удовлетворяет моему еретическому пристрастию к аккуратной вселенной, но это действительно хорошее базовое решение! - person jogall; 31.01.2018

Я не могу предложить однострочник, но вы могли бы рассмотреть здесь и рекурсию.

flat <- function(l, s = NULL) {
  lapply(1:length(l), function(i) {
    if (is.list(l[[i]])) {
      do.call(rbind, flat(l[[i]], i))
    } else {
      cbind(l[[i]], id = if (is.null(s)) i else s, section = if (is.null(s)) 1 else i)
    }
  })
}

a <- do.call(rbind, flat(gc_all))
all.equal(data.frame(a), gc_fortified)

[1] TRUE
person erocoar    schedule 31.01.2018
comment
Спасибо, чуть круче. Я все еще надеюсь на волшебную do.call("rbind.fill", ...) остроту! - person jogall; 31.01.2018