循环分组数据并执行

Question

假设我有以下示例：

我的原始数据集包括从VisitLink 到Dis 3 的变量。我想创建一个新的变量new，这样当我按Patient 对数据进行分组时，回顾该患者就诊前的20 天，检查Dis1 在当时的任何一次就诊中是否为真。我想要的new 是：

我做了几次尝试，但他们都忽略了分组。

Patient DaysToEvent  Dis1  Dis2  Dis3   new
      1         130  TRUE FALSE FALSE  TRUE
      1         135 FALSE FALSE FALSE  TRUE
      2         456  TRUE  TRUE FALSE  TRUE
      2         500 FALSE FALSE FALSE  FALSE
      2         550  TRUE FALSE FALSE  TRUE
      2         560 FALSE  TRUE  TRUE  TRUE
      3         200 FALSE FALSE FALSE  FALSE
      3         400  TRUE  TRUE FALSE  TRUE
      3         410 FALSE  TRUE FALSE  TRUE
      3         510 FALSE FALSE FALSE  FALSE
      4           1  TRUE FALSE FALSE  TRUE
      4          20 FALSE  TRUE FALSE  TRUE
      4         110 FALSE FALSE FALSE  FALSE

谢谢！

Answer 1

1) 创建一个函数gen_new，它为每个患者填写缺失的日期编号，给出m。然后它使用rollapplyr 和any(..., na.rm = TRUE) 来查找尾随的20 个或更少的元素中的任何一个是否为TRUE，然后使用window 将结果子集返回到存在的日期。要将其应用于所有患者，请使用ave。 ave 将强制 gen_new 产生的逻辑为 0/1，因此将其输出与 1 进行比较以转换回逻辑。

library(zoo)

n <- nrow(DF)

gen_new <- function(ix) with(DF[ix, ], {
  rng <- range(DaysToEvent)
  m <- merge(zoo(Dis1, DaysToEvent), zoo(, seq(rng[1], rng[2])))
  window(rollapplyr(m, 20, any, na.rm = TRUE, partial = TRUE), DaysToEvent)
})

DF <- transform(DF, new2 = ave(1:n, Patient, FUN = gen_new) == 1)

# check that new and new2 are the same
identical(DF$new, DF$new2)
## [1] TRUE

2) 这个避免了 (1) 中的合并，因此可能更快。它定义了一个函数Any，它接受一个逻辑动物园对象，并确定在结束的 20 内是否有任何 TRUE 元素。然后它将gen_new 定义为rollapplyr 它针对一个人。最后，它使用ave 将其应用于每个人。

library(zoo)

n <- nrow(DF)

Any <- function(x) any(x[time(x) > end(x) - 20], na.rm = TRUE)

gen_new <- function(ix) with(DF[ix, ], {
  z <- zoo(Dis1, DaysToEvent)
  rollapplyr(z, 20, Any, coredata = FALSE, partial = TRUE)
})

DF <- transform(DF, new2 = ave(1:n, Patient, FUN = gen_new) == 1)

# check that new and new2 are the same
identical(DF$new, DF$new2)
## [1] TRUE

注意：输入数据DF的可复现形式为：

Lines <- "Patient DaysToEvent  Dis1  Dis2  Dis3   new
      1         130  TRUE FALSE FALSE  TRUE
      1         135 FALSE FALSE FALSE  TRUE
      2         456  TRUE  TRUE FALSE  TRUE
      2         500 FALSE FALSE FALSE  FALSE
      2         550  TRUE FALSE FALSE  TRUE
      2         560 FALSE  TRUE  TRUE  TRUE
      3         200 FALSE FALSE FALSE  FALSE
      3         400  TRUE  TRUE FALSE  TRUE
      3         410 FALSE  TRUE FALSE  TRUE
      3         510 FALSE FALSE FALSE  FALSE
      4           1  TRUE FALSE FALSE  TRUE
      4          20 FALSE  TRUE FALSE  TRUE
      4         110 FALSE FALSE FALSE  FALSE"
DF <- read.table(text = Lines, header = TRUE)

Answer 2

我愿意接受更有效的建议，但这里是仅使用 dplyr 的解决方案：

library(tidyr)
library(dplyr)

group_by(mydata,Patient) %>% 
    do(new = sapply(.$DaysToEvent,function(x)
        {
            any(.$Dis1*between(.$DaysToEvent,x-20,x))
        }
    ) %>% 
    unnest()