R中特定事件之间的日期差异

时间:2013-07-18 20:40:06

标签: r datediff

我花了很多时间试图计算特定事件之间的日期差异。例如,我有下面的数据集,其中t是事件日期时间,e是事件('A'或'R'),id是标识符。

t                   e   id
2013-06-15 20:59:17 A   086
2013-06-26 18:02:09 R   086
2013-06-27 03:17:07 A   086
2013-06-01 11:34:09 R   115
2013-06-16 19:59:08 R   522
2013-06-16 20:05:04 R   522
2013-06-07 09:31:15 A   524
2013-06-09 16:24:04 R   524
2013-06-14 03:38:09 A   524
2013-06-16 15:49:09 R   524
2013-06-21 03:54:19 A   524
2013-06-12 12:34:37 A   638
2013-06-12 13:15:27 A   638
2013-06-15 16:12:23 R   638
2013-06-18 22:05:03 A   638
2013-06-28 13:30:20 R   638
2013-06-28 22:20:12 A   638
2013-06-01 18:34:46 A   836
2013-06-01 18:44:53 A   836
2013-06-03 14:35:09 R   836
2013-06-03 20:25:51 A   836
2013-06-03 20:27:25 A   836
2013-06-03 20:32:17 A   836
2013-06-08 16:22:07 R   836
2013-06-12 13:12:21 A   836
2013-06-12 13:15:16 A   836
2013-06-12 13:18:53 A   836
2013-06-12 18:59:24 A   836
2013-06-23 21:14:12 R   836
2013-06-24 20:16:11 R   836
2013-06-25 03:34:29 A   836
2013-06-26 20:33:11 R   836

想要创建一个新的数据集,对于每个id,我会得到'A'事件和'R'事件之间的日期时间差异(以天为单位)。

对于每个id:如果在E之前没有事件A则不计算任何内容。如果在两个事件E之前有三个事件A,则计算具有第一个事件A和第一个事件E的差异天数。如果只有事件A或E则不计算任何事件。然后,对于id = 086,115,638我想得到这个双重(id,天)(086,10.9)(638,3.2)(638,9.6)。 id = 115没有出现或者可能是NaN,因为它只有一个事件R并且之前没有事件A.

id  days 
086 10.9  (Ex. 2013-06-26 18:02:09 - 2013-06-15 20:59:17)
524 2.3
524 2.5
638 3.2
638 9.6
836 1.8
836 4.8   (Ex. 2013-06-08 16:22:07 - 2013-06-03 20:25:51)
836 11.3
836 1.7

我正在使用此代码作为第一种方法:

聚合(as.POSIXct(df $ t),list(df $ id),diff)

关于如何做到这一点的任何想法?提前谢谢。

数据框的输入是:

> dput(df)
structure(list(t = c("2013-06-15 20:59:17", "2013-06-26 18:02:09", 
"2013-06-27 03:17:07", "2013-06-01 11:34:09", "2013-06-16 19:59:08", 
"2013-06-16 20:05:04", "2013-06-07 09:31:15", "2013-06-09 16:24:04", 
"2013-06-14 03:38:09", "2013-06-16 15:49:09", "2013-06-21 03:54:19", 
"2013-06-12 12:34:37", "2013-06-12 13:15:27", "2013-06-15 16:12:23", 
"2013-06-18 22:05:03", "2013-06-28 13:30:20", "2013-06-28 22:20:12", 
"2013-06-01 18:34:46", "2013-06-01 18:44:53", "2013-06-03 14:35:09", 
"2013-06-03 20:25:51", "2013-06-03 20:27:25", "2013-06-03 20:32:17", 
"2013-06-08 16:22:07", "2013-06-12 13:12:21", "2013-06-12 13:15:16", 
"2013-06-12 13:18:53", "2013-06-12 18:59:24", "2013-06-23 21:14:12", 
"2013-06-24 20:16:11", "2013-06-25 03:34:29", "2013-06-26 20:33:11"
), e = c("A", "R", "A", "R", "R", "R", "A", "R", "A", "R", "A", 
"A", "A", "R", "A", "R", "A", "A", "A", "R", "A", "A", "A", "R", 
"A", "A", "A", "A", "R", "R", "A", "R"), id = c("086", "086", 
"086", "115", "522", "522", "524", "524", "524", "524", "524", 
"638", "638", "638", "638", "638", "638", "836", "836", "836", 
"836", "836", "836", "836", "836", "836", "836", "836", "836", 
"836", "836", "836")), .Names = c("t", "e", "id"), row.names = c(855945L, 
1481100L, 1508045L, 16944L, 920490L, 921005L, 349201L, 494172L, 
746450L, 904442L, 1163757L, 653045L, 654357L, 834901L, 1047932L, 
1583218L, 1613753L, 36421L, 37178L, 139968L, 162274L, 162417L, 
162804L, 430725L, 654254L, 654350L, 654453L, 670726L, 1333676L, 
1384583L, 1401293L, 1491782L), class = "data.frame")

3 个答案:

答案 0 :(得分:3)

以下是一行解决方案,使用ddply包中的plyr函数和lubridate包来解析日期。

代码:

library(plyr)
library(lubridate)

new_df <- ddply(.data=df, .variables=c('id'), summarize,
                days=round(ymd_hms(t[match('R',e)])-ymd_hms(t[match('A',e)]),1))
new_df

输出:

   id      days
1 086 10.9 days
2 115   NA days
3 522   NA days
4 524  2.3 days
5 638  3.2 days
6 836  1.8 days

请注意,有2个警告,因为id的115和522没有e变量的值。

如果您希望日期差异为十进制值,则可以使用as.double函数,如下所示:

基本上,我使用match函数来查找AR的第一个匹配项,使用{{1}中的ymd_hms函数解析日期变量包,然后找到两个日期的差异。我将它四舍五入到小数点后1位,然后将其转换为lubridate进行显示。

修改

在阅读OP评论后,这是获得理想结果的一种相当丑陋的方式。请原谅我,它是清晨,可能不是优雅或有效,但它似乎输出了预期的结果。

代码:

double

输出:

grouper <- function(var, group) {
  num <- 1
  res <- c(1:length(var))
  for(i in 1:length(var)) {
    res[i] <- num
    if(var[i]==group) {
      num <- num+1
    }
  }
  return(res)
}

df2 <- df
df2$group <- ddply(.data=df, .variables='id', summarize, group=grouper(e,'R'))$group

df3 <- ddply(.data=df2, .variables=c('id','group'), summarize,
             days=round(ymd_hms(t[match('R',e)])-ymd_hms(t[match('A',e)]),1))

df3[complete.cases(df3),-2]

这个想法是添加另一个列,通过发生'R'事件对行进行分组,这样我就可以通过ID和'R'事件对数据集进行子集化。它有点hacky,我相信有更优雅的方法可以做到。

现在,我要去喝咖啡了。

答案 1 :(得分:3)

不需要任何东西,但基本的R.订购您的data.frame,选择您的&#34;首先&#34;外观,最后使用类似于你使用的聚合:

df <- df[do.call(order, df), ]
df <- df[!duplicated(df[, c("id", "e")]), ]
tdiff <- function(x) {
  if(length(x) == 2) {
     rv <- as.numeric(difftime(strptime(x[2], format="%Y-%m-%d %H:%M:%S"),
                               strptime(x[1], format="%Y-%m-%d %H:%M:%S"),
                               units = "days"))
  } else {
     rv <- NA
  }
  rv
}

rv <- aggregate(df$t, by = list(id = df$id), tdiff)

只是为了关闭,因为你不再需要它,这里的版本可以按照你想要的方式工作。

df <- df[do.call(order, df), ]
df_a <- subset(df, e == "A")
df_a <- df_a[!duplicated(df_a[, c("id", "e")]), ]
df_r <- subset(df, e == "R")
df_r[, 'A'] <- df_a[match(df_r$id, df_a$id), 't']
df_r[, 'R_A'] <- as.numeric(difftime(strptime(df_r[, 't'], format="%Y-%m-%d %H:%M:%S"),
                           strptime(df_r[, 'A'], format="%Y-%m-%d %H:%M:%S"),
                           units = "days"))
rv <- df_r[, c('id', 'R_A')]
rv[!is.na(rv$R_A) & rv$R_A < 0, 'R_A'] <- NA
rv <- rv[!duplicated(rv), ]

答案 2 :(得分:2)

这是一种方法

df <- transform(df, t=as.POSIXct(t))
sp <- split(df, df$id)
calc_diff <- function(x) {
    start <- min(subset(x, e=="A")$t)
    end <- min(subset(x, e=="R")$t)
    return(end-start)
}
sapply(sp, FUN=calc_diff)