R：选择某一阈值以上的n个连续行的第一行

Question

我有一个包含MRN，日期和测试值的数据帧。

我需要选择所有第一每具有高于0.5连续值MRN行。

这是数据的示例版本：

MRN Collected_Date ANC 
1 001  2015-01-02 0.345 
2 001  2015-01-03 0.532 
3 001  2015-01-04 0.843 
4 001  2015-01-05 0.932 
5 002  2015-03-03 0.012 
6 002  2015-03-05 0.022 
7 002  2015-03-06 0.543 
8 002  2015-03-07 0.563 
9 003  2015-08-02 0.343 
10 003  2015-08-03 0.500 
11 003  2015-08-04 0.734 
12 003  2015-08-05 0.455 
13 004  2014-01-02 0.001 
14 004  2014-01-03 0.500 
15 004  2014-01-04 0.562 
16 004  2014-01-05 0.503 

示例代码：

df <- data.frame(MRN = c('001','001','001','001', 
         '002','002','002','002', 
         '003','003','003','003', 
         '004','004','004','004'), 
       Collected_Date = as.Date(c('01-02-2015','01-03-2015','01-04-2015','01-05-2015', 
              '03-03-2015','03-05-2015','03-06-2015','03-07-2015', 
              '08-02-2015','08-03-2015','08-04-2015','08-05-2015', 
              '01-02-2014','01-03-2014','01-04-2014','01-05-2014'), 
              format = '%m-%d-%Y'), 
       ANC = as.numeric(c('0.345','0.532','0.843','0.932', 
         '0.012','0.022','0.543','0.563', 
         '0.343','0.500','0.734','0.455', 
         '0.001','0.500','0.562','0.503'))) 

目前，我使用的是很别扭的方法使用滞后函数来计算的时间差，然后过滤所有>> = 0.5的值，然后总结这些值，这有助于选择THIRD值的日期。然后我。减去两天时间到达第一值的日期：

df %>% group_by(MRN) %>% 
    mutate(., days_diff = abs(Collected_Date[1] - Collected_Date)) %>% 
     filter(ANC >= 0.5) %>% 
      mutate(days = days_diff + lag((days_diff))) %>% 
       filter(days == 5) %>% 
        mutate(Collected_Date = Collected_Date - 2) %>% 
         select(MRN, Collected_Date) 

输出：

来源：本地数据帧[2×2] 组：MRN

MRN Collected_Date 
1 001  2015-01-03 
2 004  2014-01-03 

有一定是一种更简单/更优雅的方式。另外，如果测试日期之间存在差距，则不会给出准确的结果。

我给这例如期望的输出是：

MRN Collected_Date ANC  
1 001  2015-01-03 0.532 
2 004  2014-01-03 0.500 

因此，如果至少三个连续的测试值> = 0.5，所述第一值的日期应被返回。

如果没有至少三个连续值> = 0.5，则应返回NA。

任何帮助，非常感谢！

非常感谢！

Answer 1

最简单的方法是将zoo库与dplyr结合使用。在zoo包内有一个叫做rollapply的函数，我们可以用它来计算一个时间窗口的函数值。

在这个例子中，我们可以应用窗口来计算下三个值的最小值，然后应用指定的逻辑。

df %>% group_by(MRN) %>% 
    mutate(ANC=rollapply(ANC, width=3, min, align="left", fill=NA, na.rm=TRUE)) %>% 
    filter(ANC >= 0.5) %>% 
    filter(row_number() == 1) 

# MRN Collected_Date ANC 
# 1 001  2015-01-03 0.532 
# 2 004  2014-01-03 0.500 

---

在上述我们的代码已经使用rollapply计算最小接下来的3项。要看到这是如何工作的比较如下：

rollapply(1:6, width=3, min, align="left", fill=NA) # [1] 1 2 3 4 NA NA 
rollapply(1:6, width=3, min, align="center", fill=NA) # [1] NA 1 2 3 4 NA 
rollapply(1:6, width=3, min, align="right", fill=NA) # [1] NA NA 1 2 3 4 

因此在我们的例子中，我们从左边对齐，因此从当前位置开始，并期待着在未来2倍的值。

最后，我们按适当的值进行过滤，并对每个组进行第一次观察。

Answer 2

这是ddply解决方案（对不起，我没有及时更新%>%语法，但也许可以应用它）。

我不确定在你的意思上它是否“优雅”，但它在第二次阅读时会有意义（这对我来说比单线更重要），并且对失踪很有帮助日期等

关键是使用rle（运行长度编码）查找'运行'ANC >= 0.5其中运行至少是长度3.这需要照顾'连续'部分。我们将其保存到r。

然后r.i给出第一次运行中的长度为3或更长的索引，并且其中运行的值为TRUE。

要获得指数x你刚才sum运行长度可达但不包括运行我们感兴趣的是，加1得到的开始（这是sum(r$lengths[1:(r.i - 1)])和+1）。

ddply(df, 
.(MRN), 
function (x) { 
    r <- rle(x$ANC >= 0.5) # find 'runs' of x$ANC >= 0.5 
    # find index of first run of length >=3 with ANC >= .5 
    r.i <- which(r$lengths >= 3 & r$values)[1] 
    if (!is.na(r.i)) { 
     # get index of first row in that run and return it. 
     return(x[sum(r$lengths[seq_len(r.i - 1)]) + 1, ]) 
    } 
    return(NULL) 
}) 

如果你提取例如数据，它会更好。 x <- subset(df, MRN == '001')并逐步了解r,r.i的样子。

Answer 3

我们可以创建给定x返回指示连续值高于给定阈值的数目的向量的向量的辅助功能：

high_run <- function(x, threshold) { 
    high <- x >= threshold 
    streak <- high[1] 
    for(h in high[2:length(high)]){ 
     streak <- c(streak, streak[length(streak)]*h + h) 
    } 
    run 
} 

以及返回在第一次运行的起始索引的函数特定长度的：

high_run_start <- function(x, threshold, run){ 
    match(run, high_run(x, threshold)) - run + 1 
} 

我们可以然后使用这个后一个函数来选择原始数据帧的适当的行：

> df %>% group_by(MRN) %>% 
+ filter(row_number()==high_run_start(ANC,0.5,3)) 
Source: local data frame [2 x 3] 
Groups: MRN 

    MRN Collected_Date ANC 
1 001  2015-01-03 0.532 
2 004  2014-01-03 0.500 

Answer 4

基本方法：

使用rle发现的3个或更多序列，并抢第一个

df <- data.frame(MRN = c('001','001','001','001','002','002','002','002','003','003','003','003','004','004','004','004'), Collected_Date = as.Date(c('01-02-2015','01-03-2015','01-04-2015','01-05-2015', '03-03-2015','03-05-2015','03-06-2015','03-07-2015', '08-02-2015','08-03-2015','08-04-2015','08-05-2015', '01-02-2014','01-03-2014','01-04-2014','01-05-2014'), format = '%m-%d-%Y'), ANC = as.numeric(c('0.345','0.532','0.843','0.932', '0.012','0.022','0.543','0.563', '0.343','0.500','0.734','0.455', '0.001','0.500','0.562','0.503'))) 

df[as.logical(with(df, ave(ANC, MRN, FUN = function(x) 
    cumsum(x >= .5 & with(rle(x >= .5), rep(lengths, lengths)) >= 3) == 1))), ] 

# MRN Collected_Date ANC 
# 2 001  2015-01-03 0.532 
# 14 004  2014-01-03 0.500 

也许这个版本更容易理解

df[as.logical(with(df, ave(ANC, MRN, FUN = function(x) { 
    r <- rle(x >= .5) 
    r <- rep(r$lengths, r$lengths) 
    cumsum(r == 3 & x >= .5) == 1 
    }))), ] 

编辑

df <- df[c(1:4,4,4,4,5,5,5,5:16), ] 
df[as.logical(with(df, ave(ANC, MRN, FUN = function(x) 
    cumsum(x >= .5 & with(rle(x >= .5), rep(lengths, lengths)) >= 3) == 1))), ] 

# MRN Collected_Date ANC 
# 2 001  2015-01-03 0.532 
# 14 004  2014-01-03 0.500