如何在数据框中为每组创建递归变量？

Question

我有一个数据集，其中包含对每位患者临床结果的多次观察。这些时间点之间的长度是可变的。我想为临床结果创建一个“流动基线分数”变量，每次在至少提前 90 天的第一个时间点确认分数的增加或减少时，该变量都会发生变化。

我创建了一个示例数据框，其中包含两名患者的观察结果（患者 1 有 6 个观察结果，患者 2 只有 2 个观察结果）：

library(dplyr)

df <- data.frame(
patID  = c("1", "1", "1", "1", "1", "1", "2", "2"),     
time_point = c("1", "2", "3", "4", "5", "6", "1", "2"),
date = as.Date(c("2020-01-01", "2020-05-01", "2020-06-01", "2020-09-01", "2021-01-01", "2021-05-01", "2020-01-01", "2020-05-01")),
score = c("300", "100", "100", "100", "200", "200", "600", "400"))

具有基线分数的向量应产生以下结果：

baseline = c("300", "300", "300", "100", "100", "200", "600", "600") 

• 解释：患者 1 的评分在时间点 2 从 300 下降到 100。这种下降可以在时间点 4 得到确认，因为这是至少提前 90 天的最近时间点。因此，时间点 4 的新基线为 100。在时间点 6，确认了分数的增加（相对于最新基线），我们获得了 200 的新基线。 患者 2 只有两个时间点，因此无法确认基线的变化。

我尝试使用 for 循环创建变量，但我不知道如何制作它，以便为每个患者单独完成。

编辑：我尝试使用 sapply 编写如下代码，但收到错误“参数长度为 0”

df_baseline <- df %>%
group_by(patID) %>%
mutate(baseline = lag(score, default = first(score)),
     closest_index_90 = sapply(1:n(), function(i) {
       valid_indices <- which(date[i]+90 <= date[(i+1):n()])
       if (length(valid_indices)>0) {return(first(valid_indices) + i)} 
       else {return(NA)}
     }),
     baseline = sapply(1:n(), function(i) {
       if (score[i:closest_index_90[i]] > baseline[i - 1] | score[i:closest_index_90[i]] < baseline[i - 1]) {return(score[which.min(abs(score[i:closest_index_90[i]]-baseline[i-1]))])}
     else {return(baseline[i-1])}}))

我对 R 比较陌生，所以我对 for 循环和 sapply 函数的技能有限。我浏览了这里提出的许多问题，但似乎没有一个具体回答我的问题。任何帮助将不胜感激！

Answer 1

这是一种不同的方法，使用滚动连接来查找间隔至少 90 天的最接近的匹配项。需要使用更多数据进行测试，但看看这是否有帮助。

library(tidyverse)

df <- tibble(
  patID = c("1", "1", "1", "1", "1", "1", "2", "2"),
  time_point = c("1", "2", "3", "4", "5", "6", "1", "2"),
  date = as.Date(c("2020-01-01", "2020-05-01", "2020-06-01", "2020-09-01", "2021-01-01", "2021-05-01", "2020-01-01", "2020-05-01")),
  score = c("300", "100", "100", "100", "200", "200", "600", "400")
)

# baseline = c("300", "300", "300", "100", "100", "200", "600", "600") 

lookup_df <- df |> 
  select(patID, lookback = date, baseline = score)

df |> 
  mutate(ninety_days = date - days(90)) |> 
  left_join(lookup_df, join_by(patID, closest(ninety_days >= lookback))) |> 
  select(-ninety_days) |> 
  group_by(patID) |> 
  fill(baseline, .direction = "up") |> 
  ungroup()
#> # A tibble: 8 × 6
#>   patID time_point date       score lookback   baseline
#>   <chr> <chr>      <date>     <chr> <date>     <chr>   
#> 1 1     1          2020-01-01 300   NA         300     
#> 2 1     2          2020-05-01 100   2020-01-01 300     
#> 3 1     3          2020-06-01 100   2020-01-01 300     
#> 4 1     4          2020-09-01 100   2020-06-01 100     
#> 5 1     5          2021-01-01 200   2020-09-01 100     
#> 6 1     6          2021-05-01 200   2021-01-01 200     
#> 7 2     1          2020-01-01 600   NA         600     
#> 8 2     2          2020-05-01 400   2020-01-01 600

^{创建于 2024-02-28，使用 reprex v2.1.0}