件名ごとにX日ごとにカウントする（不規則な時系列で）

Question

私はケアのエピソード（ER訪問のような）を数えているところのデータを持っています。トリックは、2回目または3回目の訪問が実際には以前の問題のフォローアップであることがあるため、すべての訪問をカウントすることはできません。だから私は30日の「クリーン期間」や「ブラックアウト期間」を使って訪問数をカウントするよう指示されています。つまり、患者（最小日）による最初のイベント（訪問1）を探して、最初のイベントの30日後に発生した訪問数をカウントしないようにルールを適用します。その30日のウィンドウが経過した後、私は2回目の訪問（訪問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! :) 

Answer 1

この溶液をループフリーであり、それはdata1の許容される行を選択する論理ベクトルokを生成するだけベースR.を使用します。

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),]))