R 跨列查找多个时间报告

每个位置使用一(list)列转换数据:

library(dplyr)
library(purrr)
library(tidyr)
(list_df <- example_data %>%
  pivot_longer(names_to = c("Type", "nr"), 
               names_pattern = "(.*)_(\\d*)", 
               cols = -id,
               names_transform = list(nr = as.integer)) %>%
  summarize(vals = list(value), .by = c(id, Type)) %>%
  pivot_wider(names_from = Type, values_from = vals) %>%
  relocate(GP, .after = Hospital))
# # A tibble: 30 × 5
#       id Hospital  GP         self_report death    
#    <int> <list>    <list>     <list>      <list>   
#  1     1 <dbl [4]> <dbl [10]> <dbl [4]>   <dbl [1]>
#  2     2 <dbl [4]> <dbl [10]> <dbl [4]>   <dbl [1]>
#  3     3 <dbl [4]> <dbl [10]> <dbl [4]>   <dbl [1]>
# [...]

对于每Hospital个，判断时间范围内是否有任何位置:

detect_reportings <- function(other, Hospital) {
  imap_chr(set_names(Hospital, paste0("Hospital_", seq_along(Hospital))),
           ~ if_else(any(abs(other - .x) <= .25), cur_column(), NA_character_)) %>%
  list()
}

此函数最终将返回每个其他位置的长度为4(==医院数量)的字符向量，如果时间范围内没有事件，则为NA，否则为位置的名称:

(dist_check <- list_df %>%
  group_by(id) %>%
  mutate(across(GP:death, ~ detect_reportings(.x[[1]], Hospital[[1]])),
         Hospital = set_names(if_else(is.na(Hospital[[1]]), NA_character_, "Hospital"),
                              paste0("Hospital_", seq_along(Hospital[[1]]))) %>%
                     list()))
# # A tibble: 30 × 5
# # Groups:   id [30]
#       id Hospital  GP        self_report death    
#    <int> <list>    <list>    <list>      <list>   
#  1     1 <chr [4]> <chr [4]> <chr [4]>   <chr [4]>
#  2     2 <chr [4]> <chr [4]> <chr [4]>   <chr [4]>
#  3     3 <chr [4]> <chr [4]> <chr [4]>   <chr [4]>
# [...]

dist_check$GP[[16]]
## Hospital_3 and Hospital_4 were within the .25 range
# Hospital_1 Hospital_2 Hospital_3 Hospital_4 
#         NA         NA       "GP"       "GP" 
example_data[16, c(4:5, 8, 14)]
# # A tibble: 1 × 4
#   Hospital_3 Hospital_4  GP_3  GP_9
#        <dbl>      <dbl> <dbl> <dbl>
# 1       25.6       19.9  25.4  19.7

最后一步是合并这些判断:

merge_reportings <- function(...) {
  cbind(...) %>%
    as_tibble() %>%
    unite("result", sep = "|", na.rm = TRUE) %>%
    t() %>%
    c() %>%
    set_names(paste0("Hospital_elsewhere_", seq_along(..1))) %>%
    as.list() %>%
    as_tibble()
}
res <- dist_check %>%
  reframe(merge_reportings(Hospital[[1]], GP[[1]], self_report[[1]], death[[1]]))
print(res, n = 10L)

# # A tibble: 30 × 5
#       id Hospital_elsewhere_1 Hospital_elsewhere_2 Hospital_elsewhere_3 Hospital_elsewhere_4
#    <int> <chr>                <chr>                <chr>                <chr>               
#  1     1 Hospital             Hospital             Hospital             "Hospital"          
#  2     2 Hospital             Hospital             Hospital             "Hospital"          
#  3     3 Hospital             Hospital             Hospital             "Hospital"          
#  4     4 Hospital             Hospital             Hospital             "Hospital"          
#  5     5 Hospital             Hospital             Hospital             "Hospital"          
#  6     6 Hospital             Hospital             Hospital|GP          "Hospital|GP"       
#  7     7 Hospital|GP          Hospital|GP          Hospital|GP          "Hospital|GP"       
#  8     8 Hospital|GP          Hospital|GP          Hospital|GP          "Hospital|GP"       
#  9     9 Hospital             Hospital             Hospital             "Hospital"          
# 10    10 Hospital             Hospital             Hospital             "Hospital"          
# # ℹ 20 more rows
# # ℹ Use `print(n = ...)` to see more rows