Question

我的对象在不同的时间有不同数量的事件。这当前以长格式存储（使用来自库（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))

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

我想将其转换为伪宽格式，其中第一列是患者ID，第二列是该对象的事件时间列表。我可以这样做，其中第二列是以下列方式的一列元素

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

我宁愿将这些对象存储为列表，因为我想使用以下函数找到每对对象之间的“距离”，我担心从列表中提取向量会增加不必要的处理，从而减慢计算

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

如果我尝试使用[[

提取列表而不是tibble

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

是否有一种相当简单的方法可以从长整数列中提取列作为列表并将其存储在新的tibble中？这甚至是解决这个问题的正确方法吗？

Answer 1

我发现使用tidyr::nest生成“列表”栏目的好方法是＆＃39;我想你可能会追随（特别是对于时间序列填充 - 是一种数据）。希望以下有所帮助！

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

创建包含长格式tibble列表的tibble（或数据框）列

1 个答案: