每个主题每隔X天计算一次事件(在不规则的时间序列中)

时间:2012-03-21 23:34:05

标签: r

我有数据,我在计算护理事件(如ER访问)。诀窍是,我无法计算每次访问,因为有时第二次或第三次访问实际上是先前问题的后续行动。因此,我已经被指定通过使用30天的“清洁期”或“停电期”来计算访问次数,这样,我会按患者(最小日期)查找第一个事件(访问1),我计算该事件,然后应用规则,以便不计算在第一个事件发生后30天内发生的任何访问。在那30天窗口过后,我可以开始寻找第二次访问(访问2),计算一次,然后再次应用30天黑色(不计算访问#2后30天内发生的任何访问)。 ..洗,冲洗,重复...

我已经将一个非常草率的解决方案整合在一起,需要大量的保姆和手动检查步骤(见下文)。我必须相信有更好的方法。救命!

data1 <- structure(list(ID = structure(c(2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 
3L, 4L, 4L, 4L, 4L, 4L), .Label = c("", "patient1", "patient2", 
"patient3"), class = "factor"), Date = structure(c(14610, 14610, 
14627, 14680, 14652, 14660, 14725, 15085, 15086, 14642, 14669, 
14732, 14747, 14749), class = "Date"), test = c(1L, 1L, 1L, 2L, 
1L, 1L, 2L, 3L, 3L, 1L, 1L, 2L, 2L, 2L)), .Names = c("ID", "Date", 
"test"), class = "data.frame", row.names = c(NA, 14L))

library(doBy) 
##     create a table of first events 
step1 <- summaryBy(Date~ID, data = data1, FUN=min) 
step1$Date30 <- step1$Date.min+30                                     
step2 <- merge(data1, step1, by.x="ID", by.y="ID") 
##     use an ifelse to essentially remove any events that shouldn't be counted 
step2$event <- ifelse(as.numeric(step2$Date) >= step2$Date.min & as.numeric(step2$Date) <= step2$Date30, 0, 1)
##     basically repeat steps above until I dont capture any more events
##  there just has to be a better way
data3 <- step2[step2$event==1,] 
data3<- data3[,1:3] 
step3 <- summaryBy(Date~ID, data = data3, FUN=min) 
step3$Date30 <- step3$Date.min+30 
step4 <- merge(data3, step3, by.x="ID", by.y="ID") 
step4$event <- ifelse(as.numeric(step4$Date) >= step4$Date.min & as.numeric(step4$Date) <= step4$Date30, 0, 1)
data4 <- step4[step4$event==1,]
data4<- data4[,1:3]
step5 <- summaryBy(Date~ID, data = data4, FUN=min)
step5$Date30 <- step5$Date.min+30
##     then I rbind the "keepers" 
##     in this case steps 1 and 3 above 
final <- rbind(step1,step3, step5) 
##     then reformat 
final <- final[,1:2] 
final$Date.min <- as.Date(final$Date.min,origin="1970-01-01") 
##     again, extremely clumsy, but it works...  HELP! :)

3 个答案:

答案 0 :(得分:6)

此解决方案是无循环的,仅使用基数R.它生成一个逻辑向量ok,用于选择data1的可接受行。

ave分别为每位患者运行指定的匿名函数。

我们定义一个状态向量,包含当前日期和未考虑其他日期的期间的开始。每个日期由as.numeric(x)表示,其中x是日期。 step获取状态向量和当前日期并更新状态向量。 Reduce在数据上运行它,然后我们只采用最小和当前日期相同且当前日期不重复的结果。

step <- function(init, curdate) {
    c(curdate, if (curdate > init[2] + 30) curdate else init[2])
}

ok <- !!ave(as.numeric(data1$Date), paste(data1$ID), FUN = function(d) {
    x <- do.call("rbind", Reduce(step, d, c(-Inf, 0), acc = TRUE))
    x[-1,1] == x[-1,2] & !duplicated(x[-1,1])
})

data1[ok, ]

答案 1 :(得分:2)

由于这种操作不直接且容易出错, 我会写一个单独的函数来在停电期间丢弃事件。 该函数包含一个循环, 这基本上是你手工做的, 直到没有什么可做的。

blackout <- function(dates, period=30) {
  dates <- sort(dates)
  while( TRUE ) {
    spell <- as.numeric(diff(dates)) <= period
    if(!any(spell)) { return(dates) }
    i <- which(spell)[1] + 1
    dates <- dates[-i]
  }
}

# Tests
stopifnot( 
  length(
    blackout( seq.Date(Sys.Date(), Sys.Date()+50, by=1) )
  ) == 2
)
stopifnot( 
  length(
    blackout( seq.Date(Sys.Date(), by=31, length=5) )
  ) == 5
)

可以如下使用。

library(plyr)
ddply(data1, "ID", summarize, Date=blackout(Date))

答案 2 :(得分:1)

怎么样

do.call('rbind', lapply(split(data1, factor(data1$ID)), function(x) (x <- x[order(x$Date),])[c(T, diff(x$Date) > 30),]))