Подсчет событий только каждые X дней для каждого субъекта (в нерегулярных временных рядах)

Question

У меня есть данные, где я рассчитываю эпизоды медицинской помощи (например, посещения ER). Хитрость в том, что я не могу сосчитать каждое посещение, потому что иногда второе или третье посещение фактически является продолжением предыдущей проблемы. Поэтому мне дали указание подсчитать посещения с использованием 30-дневного «чистого периода» или «периода полного отключения», чтобы я искал первое событие (ПОСЕЩЕНИЕ 1) по пациенту (минимальная дата), я считаю это событие , затем примените правила, чтобы НЕ считать количество посещений, которые произошли в течение 30 дней после первого события. По истечении этого 30-дневного окна я могу начать поиск 2-го посещения (ПОСЕЩЕНИЕ 2), подсчитать его, затем снова применить 30-дневное затемнение (НЕ считая посещений, которые происходят в течение 30 дней после посещения № 2). .. стирать, полоскать, повторять ...

Я собрал очень неаккуратное решение, которое требует большой няни и ручной проверки шагов (см. Ниже). Я должен верить, что есть лучший способ. ПОМОГИТЕ!

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! :)

Answer 1

Это решение не содержит петель и использует только базу 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, ]

Answer 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))

Answer 3

Как насчет

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