R中具有某些条件的行之间来自不同列的日期差异

Question

数据框有三列。第一列是包含多个机器编号（M1，M2..）的机器名称，第二列是关于测试类型的测试 1，最后测试日期表示执行测试的时间。

以下是数据框供参考：-

Name  Test     Test_Date 
 M1    Test1    10/16/2011
 M1    Test1    1/29/2012
 M1    Test1    1/29/2012
 M2    Test1    7/26/2011
 M2    Test1    7/26/2011
 M2    Test1    5/12/2012
 M2    Test1    5/12/2012
 M2    Test1    10/29/2013
 M3    Test1    9/28/2011
 M3    Test1    1/8/2012
 M3    Test1    9/16/2012
 M3    Test1    6/3/2013
 M3    Test1    7/11/2013
 M3    Test1    8/10/2013
 M3    Test1    9/13/2013

这个想法是创建一个名为“问题”（是/否）的新列，指示机器是否在 48 周内经历了两次或更多测试（Test1）。 浏览了该解决方案的多个资源，但找不到合适的资源。

Answer 1

第一个版本需要一些改进，因为我认为在每台机器少于三行的情况下它会失败。在检查了足够数量的日期后，第二个版本从第三行开始，依次检查每个后续日期，看看前面的两个测试是否都在 48 周内。

> dat <- read.table(text="Name  Test     Test_Date 
+  M1    Test1    10/16/2011
+  M1    Test1    1/29/2012
+  M1    Test1    1/29/2012
+  M2    Test1    7/26/2011
+  M2    Test1    7/26/2011
+  M2    Test1    5/12/2012
+  M2    Test1    5/12/2012
+  M2    Test1    10/29/2013
+  M3    Test1    9/28/2011
+  M3    Test1    1/8/2012
+  M3    Test1    9/16/2012
+  M3    Test1    6/3/2013
+  M3    Test1    7/11/2013
+  M3    Test1    8/10/2013
+  M3    Test1    9/13/2013", header=TRUE)
> dat$Tdate <- as.Date(dat$ Test_Date, format="%m/%d/%Y")

> dat$twoIn48wk <- with(dat, ave(as.numeric(Tdate) , Name, 
              FUN=function(x) { z=c(NA,NA); 
                            for( i in seq_along(x)[-(1:2)] ){
                                z <- c(z, (x[i]-x[i-1])<=48*7 & 
                                           (x[i]-x[i-2]) <=48*7)}
                            return(z) }) )
> dat
   Name  Test  Test_Date      Tdate twoIn48wk
1    M1 Test1 10/16/2011 2011-10-16        NA
2    M1 Test1  1/29/2012 2012-01-29        NA
3    M1 Test1  1/29/2012 2012-01-29         1
4    M2 Test1  7/26/2011 2011-07-26        NA
5    M2 Test1  7/26/2011 2011-07-26        NA
6    M2 Test1  5/12/2012 2012-05-12         1
7    M2 Test1  5/12/2012 2012-05-12         1
8    M2 Test1 10/29/2013 2013-10-29         0
9    M3 Test1  9/28/2011 2011-09-28        NA
10   M3 Test1   1/8/2012 2012-01-08        NA
11   M3 Test1  9/16/2012 2012-09-16         0
12   M3 Test1   6/3/2013 2013-06-03         0
13   M3 Test1  7/11/2013 2013-07-11         1
14   M3 Test1  8/10/2013 2013-08-10         1
15   M3 Test1  9/13/2013 2013-09-13         1

这将对边缘条件进行测试：

dat$twoIn48wk <- with(dat, ave(as.numeric(Tdate) , Name, 
              FUN=function(x) { if(length(x) < 3){rep(FALSE, length(x))} else{
                                 z=c(NA,NA); 
                            for( i in seq_along(x)[-(1:2)] ){
                                z <- c(z, (x[i]-x[i-1])<=48*7 & 
                                           (x[i]-x[i-2]) <=48*7)}
                            return(z) }}) )

Answer 2

我想你想要这样的东西？

library(dplyr)
library(lubridate)

dat <- read.table(textConnection("Name  Test     Test_Date 
 M1    Test1    10/16/2011
 M1    Test1    1/29/2012
 M1    Test1    1/29/2012
 M2    Test1    7/26/2011
 M2    Test1    7/26/2011
 M2    Test1    5/12/2012
 M2    Test1    5/12/2012
 M2    Test1    10/29/2013
 M3    Test1    9/28/2011
 M3    Test1    1/8/2012
 M3    Test1    9/16/2012
 M3    Test1    6/3/2013
 M3    Test1    7/11/2013
 M3    Test1    8/10/2013
 M3    Test1    9/13/2013"), header = TRUE, stringsAsFactors = FALSE) %>%
  mutate(Test_Date = mdy(Test_Date))

has_issue <- function(dates, current, duration = weeks(8)) {
  as.period(min(abs(interval(dates[-current], dates[current])))) <= duration
}

group_by(dat, Name, Test) %>%
  do({
    dates <- .$Test_Date
    mutate(., row_id = row_number()) %>%
      rowwise() %>%
      transmute(Test_Date, issue = has_issue(dates, row_id))
  }) %>%
  ungroup

返回

Source: local data frame [15 x 4]

Name  Test  Test_Date issue
1    M1 Test1 2011-10-16 FALSE
2    M1 Test1 2012-01-29  TRUE
3    M1 Test1 2012-01-29  TRUE
4    M2 Test1 2011-07-26  TRUE
5    M2 Test1 2011-07-26  TRUE
6    M2 Test1 2012-05-12  TRUE
7    M2 Test1 2012-05-12  TRUE
8    M2 Test1 2013-10-29 FALSE
9    M3 Test1 2011-09-28 FALSE
10   M3 Test1 2012-01-08 FALSE
11   M3 Test1 2012-09-16 FALSE
12   M3 Test1 2013-06-03  TRUE
13   M3 Test1 2013-07-11  TRUE
14   M3 Test1 2013-08-10  TRUE
15   M3 Test1 2013-09-13  TRUE

Answer 3

df <- data.frame(Test=c('Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1','Test1'), Name=c('M1','M1','M1','M2','M2','M2','M2','M2','M3','M3','M3','M3','M3','M3','M3'), Test_Date=as.Date(c('10/16/2011','1/29/2012','1/29/2012','7/26/2011','7/26/2011','5/12/2012','5/12/2012','10/29/2013','9/28/2011','1/8/2012','9/16/2012','6/3/2013','7/11/2013','8/10/2013','9/13/2013'),'%m/%d/%Y') );
SPAN <- 48*7;
MINTESTS <- 2;
df$issue <- ave(as.integer(df$Test_Date),df$Name,df$Test,FUN=function(dates) apply(outer(dates,dates,`-`),1,function(diffs) if (sum(abs(diffs)<SPAN) >= MINTESTS) 'Yes' else 'No'));
df;
##     Test Name  Test_Date issue
## 1  Test1   M1 2011-10-16   Yes
## 2  Test1   M1 2012-01-29   Yes
## 3  Test1   M1 2012-01-29   Yes
## 4  Test1   M2 2011-07-26   Yes
## 5  Test1   M2 2011-07-26   Yes
## 6  Test1   M2 2012-05-12   Yes
## 7  Test1   M2 2012-05-12   Yes
## 8  Test1   M2 2013-10-29    No
## 9  Test1   M3 2011-09-28   Yes
## 10 Test1   M3 2012-01-08   Yes
## 11 Test1   M3 2012-09-16   Yes
## 12 Test1   M3 2013-06-03   Yes
## 13 Test1   M3 2013-07-11   Yes
## 14 Test1   M3 2013-08-10   Yes
## 15 Test1   M3 2013-09-13   Yes

注意事项：

• 我使用 as.Date(c(...),'%m/%d/%Y') 将您的日期字符串强制转换为 Date 类，这是准备按日期算术所必需的。
• 如您所见，我硬编码了SPAN（给定测试日期周围的天数，被认为是其“跨度”的一部分）和MINTESTS（跨度内的最小测试数量以符合条件） issue='Yes') 的行作为全局环境中的常量。
• 我不得不将ave() 的第一个参数强制为整数，否则ave() 会自动尝试将返回值强制强制为Date 类，这将失败，因为'Yes' 和'No' 无效日期字符串。这是来自ave() 的令人讨厌的行为，似乎不可配置。幸运的是，输入df$Test_Date 不需要像我在FUN() 中使用的那样归类为Date。
• 我按df$Name 和df$Test 分组，因此每个机器/测试对的处理方式不同，关于在该机器的特定测试日期前后SPAN 天是否有MINTESTS 测试/测试。
• FUN() 的工作原理是计算该机器/测试对的每一对日期之间的天差（这是 outer(dates,dates,`-`) 计算的），然后，对于结果差矩阵中的每一行，计算其中有多少绝对差在SPAN，并根据该计数是否超过 MINTESTS 进行分支；如果是，则返回 'Yes'；如果没有，则返回 'No'。因此issue 列是ave() 调用的结果，可以直接分配给df$issue。

---

这是绘制这些数据的一种方法：

## compute a key frame: one line per machine/test
pairs <- unique(df[,c('Name','Test')]);

## precompute ticks
xtick <- seq(seq(min(df$Test_Date),by='-1 month',len=2)[2],seq(max(df$Test_Date),by='1 month',len=2)[2],'month');
yspace <- 1/(nrow(pairs)+1);
pairs$ytick <- seq(yspace,1-yspace,len=nrow(pairs));

## precompute point colors using named character vector
pointColor <- c(No='red',Yes='blue');

## draw the plot
par(mar=c(6,6,3,3)+0.1,xaxs='i',yaxs='i'); ## set global plot params
plot(NA,xlim=c(min(xtick),max(xtick)),ylim=c(0,1),axes=F,xlab='',ylab=''); ## define plot bounds
with(merge(df,pairs),points(Test_Date,ytick,col=pointColor[issue],pch=4,cex=1)); ## plot points
axis(1,xtick,strftime(xtick,'%Y-%m'),las=2); ## x-axis
axis(2,c(0,pairs$ytick,1),NA,tcl=0); ## y-axis (full extent, no tick marks)
axis(2,pairs$ytick,paste0(pairs$Name,':',pairs$Test),las=1); ## y-axis (just labels and tick marks on main lines)
title('Machine Test Coverage'); ## title