0

我有一个嵌套的列表列表，我想将其展平为带有 id 变量的数据框，这样我就知道每个列表元素（和子列表元素）来自哪个列表元素（和子列表元素）。

> 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)用于扁平化列表，但由于列表长度可变，我似乎遇到了麻烦：一些列表元素仅包含一个数据框，而其他列表元素包含两个数据框的列表。

我找到了一个使用两个lapplys 和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
4

3 回答 3

3

我想我更喜欢已经显示的递归解决方案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))))

更新已修复。

于 2018-01-31T15:42:49.763 回答
2

我不能提供单行，但你也可以在这里考虑递归

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
于 2018-01-31T14:03:12.113 回答
2

首先需要修改列表的结构，使其成为常规列表列表，然后我们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")
于 2018-01-31T15:41:01.110 回答