R中的行与来自不同列的某些条件之间的日期差异
数据框有三列。第一列是具有多个机器编号（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
这个想法是创建一个名为＆＃34; issue＆＃34;（Yes / No）的新列，它指示一台机器在48周内是否经历了两次或多次测试（Test1）。 查看了此解决方案的多种资源，但无法找到合适的解决方案。
3 个答案:
答案 0 :(得分：0)
我想你想要这样的东西？
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
答案 1 :(得分：0)
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
注意：
- 我使用
Date强制将您的日期字符串强制转换为as.Date(c(...),'%m/%d/%Y')，这是准备日期算术所必需的。 - 正如您所看到的，我对
SPAN进行了硬编码（围绕给定考试日期的天数被认为是其＆＃34; span＆＃34;的一部分）和MINTESTS（在全局环境中作为常量来限定范围内的最小测试次数（issue='Yes'）。 - 我不得不将
ave()的第一个参数强制转换为整数，否则ave()会自动尝试将返回值强制转换为Date类，这会失败，因为{{1} }和'Yes'不是有效的日期字符串。这是来自'No'的烦人行为，似乎不可配置。幸运的是，输入ave()不需要像df$Test_Date中那样使用Date。 - 我按
FUN()和df$Name进行分组，因此对于df$Test天内是否有MINTESTS次测试，每台机器/测试对的处理方式都不同围绕该机器/测试的特定测试日期。 -
SPAN的工作原理是计算该机器/测试对的每一对日期之间的日差（即FUN()计算的内容），然后，对于得到的差异中的每一行矩阵，计算这些绝对差异中有多少在outer(dates,dates,`-`)之内，并分析该计数是否超过SPAN;如果是，则返回MINTESTS;如果没有，则返回'Yes'。因此，'No'列来自issue来电，可以直接分配到ave()。
以下是您可以绘制此数据的一种方式：
df$issue 
答案 2 :(得分：0)
第一个版本需要一些改进，因为我觉得它在每台机器少于三行的情况下失败了。在检查了足够数量的日期之后，第二个版本从第三行开始，并按顺序检查每个后续日期，以查看之前的两个测试是否都在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) }}) )
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？