将函数应用于嵌套列表

Question

我有一个包含基于ID 的嵌套列表的数据框。我正在尝试将一个函数应用于此数据框中的嵌套列表，但我遇到了这个错误：

Error in make_track(tbl = x, .x = x, .y = y, .t = date, uid = ID, crs = sp::CRS("+init=epsg:32612")) : Non existent columns from tbl were requested.

这是我的可重现示例。我想知道将函数应用于嵌套列表的最佳方法可能是什么，以及如何解决此错误。我必须做一个双重lapply 来解决这个问题吗？

set.seed(12345)
library(lubridate)
library(dplyr)
library(amt)

f = function(data){
  data %>% mutate(
    new = floor_date(data$date, "10 days"),
    new = if_else(day(new) == 31, new - days(10), new)
  ) %>% 
    group_split(new)
}

nested <- tibble(
  ID = rep(c("A","B","C","D", "E"), 100),
  date = rep_len(seq(dmy("01-01-2010"), dmy("31-12-2013"), by = "days"), 500),
  x = runif(length(date), min = 60000, max = 80000),
  y = runif(length(date), min = 800000, max = 900000)
) %>% group_by(ID) %>% 
  nest() %>% 
  mutate(data = map(data, f))


track_list <- lapply(nested, function (x){
  make_track(tbl = x, .x = x, .y = y, .t = date,
             uid = ID,
             # lat/long: 4326 (lat/long, WGS84 datum).
             # utm: crs = sp::CRS("+init=epsg:32612"))
             crs = sp::CRS("+init=epsg:32612"))
})

Answer 1

问题是数据是nested，所以我们需要在里面多做一层来获取数据。另外，make_track 要求所有列都在同一个数据对象中，所以我们需要从nested 对象的“ID”列中创建对应的uid

library(purrr)
library(dplyr)
library(amt)
out <- map2_dfr(nested$ID, nested$data, function(z, lst1)
    map_dfr(lst1, ~ {
           dat <- .x %>% 
               mutate(ID = z)
      make_track(tbl = dat, .x = x, .y = y, .t = date, uid = ID, 
         crs = sp::CRS("+init=epsg:32612"))
      }))

-输出

> out
# A tibble: 500 x 4
       x_      y_ t_         uid  
    <dbl>   <dbl> <date>     <chr>
 1 74418. 820935. 2010-01-01 A    
 2 63327. 885896. 2010-01-06 A    
 3 60691. 873949. 2010-01-11 A    
 4 69250. 868411. 2010-01-16 A    
 5 69075. 876142. 2010-01-21 A    
 6 67797. 829892. 2010-01-26 A    
 7 75860. 843542. 2010-01-31 A    
 8 67233. 882318. 2010-02-05 A    
 9 75644. 826283. 2010-02-10 A    
10 66424. 853789. 2010-02-15 A    
# … with 490 more rows

---

如果我们希望输出为嵌套列表，请使用删除 _dfr

out <- map2(nested$ID, nested$data, function(z, lst1)
    map(lst1, ~ {
           dat <- .x %>% 
               mutate(ID = z)
      make_track(tbl = dat, .x = x, .y = y, .t = date, uid = ID, 
         crs = sp::CRS("+init=epsg:32612"))
      }))