创建包含来自 long-format tibble 的列表的 tibble(或数据框)的列

Create column of a tibble (or data frame) that contains a list from a long-format tibble

我有 object 个在不同时间有不同数量的事件。目前以长格式存储(使用库(tidyverse)中的小标题):

timing_tbl <- tibble(ID = c(101,101,101,102,102,103,103,103,103),
                     event_time = c(0,4,8,0,6,0,4,9,12))

真实数据有几千个objects,最多有50个左右的事件,所以我想让这个过程尽可能高效。

我想将其转换为 pseudo-wide 格式,其中第一列是患者 ID,第二列是 object 的事件时间列表。我可以通过以下方式在第二列是一列 tibbles 的情况下做到这一点

tmp <- lapply(unique(timing_tbl$ID),
               function(x) timing_tbl[timing_tbl$ID == x, "event_time"])

timing_tbl2 <- tibble(unique(timing_tbl$ID),tmp)

> timing_tbl2[1,2]
# A tibble: 1 x 1
  tmp             
  <list>          
1 <tibble [3 × 1]>
> timing_tbl2[[1,2]]
# A tibble: 3 x 1
  event_time
       <dbl>
1       0   
2       4.00
3       8.00

我更愿意将这些 objects 存储为列表,因为我想使用以下函数找到每对 objects 之间的“距离”,我担心提取列表中的向量增加了不必要的处理,减慢了计算速度。

lap_exp2 <- function(x,y,tau) {
  exp(-abs(x - y)/tau)
}

distance_lap2 <- function(vec1,vec2,tau) {
  ## vec1 is first list of event times
  ## vec2 is second list of event times
  ## tau is the decay parameter
  0.5*(sum(outer(vec1,vec1,FUN=lap_exp2, tau = tau)) +
       sum(outer(vec2,vec2,FUN=lap_exp2, tau = tau))
       ) -
       sum(outer(vec1,vec2,FUN=lap_exp2, tau = tau))

}

distance_lap2(timing_tbl2[[1,2]]$event_time,timing_tbl2[[2,2]]$event_time,2)
[1] 0.8995764

如果我尝试使用 [[

提取列表而不是小标题
tmp <- lapply(unique(timing_tbl$ID),
               function(x) timing_tbl[[timing_tbl$ID == x, "event_time"]])

我得到以下错误,这是有道理的

Error in col[[i, exact = exact]] : attempt to select more than one element in vectorIndex

有没有一种相当简单的方法可以从长标题中提取列作为列表并将其存储在新标题中?这甚至是正确的方法吗?

我发现使用 tidyr::nest 是生成 'list columns' 的好方法,我想您可能会喜欢(尤其是及时填充 series-ish 类数据)。希望以下内容对您有所帮助!

library(dplyr)
library(tidyr)
library(purrr)

timing_tbl <- tibble(ID = c(101,101,101,102,102,103,103,103,103),
                     event_time = c(0,4,8,0,6,0,4,9,12))

ID_times <-
    timing_tbl %>%
    group_by(ID) %>%
    nest(.key = "times_df") %>%
    split(.$ID) %>%
    map(~ .$times_df %>% unlist(use.names = F))

# > ID_times
# $`101`
# [1] 0 4 8

# $`102`
# [1] 0 6

# $`103`
# [1]  0  4  9 12

dists_long <-
    names(ID_times) %>% 
    expand.grid(IDx = ., IDy = .) %>%
    filter(IDx != IDy) %>%
    rowwise() %>% 
    mutate(dist = distance_lap2(vec1 = ID_times[[IDx]], vec2 = ID_times[[IDy]], tau = 2))

# # A tibble: 6 x 3
#   IDx   IDy    dist
#   <fct> <fct> <dbl>
# 1 102   101   0.900
# 2 103   101   0.981
# 3 101   102   0.900
# 4 103   102   1.68 
# 5 101   103   0.981
# 6 102   103   1.68