開始時刻と終了時刻の近接によるグループの日付間隔のグループ化

Question

日付間隔を表す一連の観測値があるとします。

library(dplyr) 
library(magrittr) 

df <- 
    data_frame(start = as.Date(c('2000-01-01', '2000-01-03', '2000-01-08', 
           '2000-01-20', '2000-01-22')), 
       end = as.Date(c('2000-01-02', '2000-01-05', '2000-01-10', 
           '2000-01-21', '2000-02-10'))) 

私はグループの観測nの開始時刻が観測n-1の終了日、次のいくつかの指定された間隔内で発生するように、これらの観察をしたいと思います。これは必ずしもそうではないが、（単純化のために、私は日付には重複がないと仮定するとしてい

#   start  end group 
#   (date)  (date) (dbl) 
# 1 2000-01-01 2000-01-02  1 
# 2 2000-01-03 2000-01-05  1 
# 3 2000-01-08 2000-01-10  1 
# 4 2000-01-20 2000-01-21  2 
# 5 2000-01-22 2000-02-10  2 

：私たちは5日とその間隔を設定している場合たとえば、私たちのようなものを見ることになりますデータの中に）。私は重み付けedgelistを作成するためにigraphを使用することを考えましたが、それはあまりにも複雑に思えました。効率は重要だと私は信じています：私はこれを約5〜10行の約400万グループのデータで実行します。

私のソリューションはうまくいきますが、私にとってはエラーが発生しやすく、遅く、厄介なようです。私はパッケージを使用したり、ベクトル化を使って実際に問題を改善すると考えています。

group_dates <- function(df, interval){ 
    # assign first date to first group 
    df %<>% arrange(start, end) 
    df[1, 'group'] <- 1 

    # for each start date, determine if it is within `interval` days of the 
    # closest end date 
    lapply(df$start[-1], function(cur_start){ 
    earlier_data <- df[df$end <= cur_start, ] 
    diffs <- cur_start - earlier_data$end 
    min_interval <- diffs[which.min(diffs)] 
    closest_group <- earlier_data$group[which.min(diffs)] 

    if(min_interval <= interval){ 
     df[df$start == cur_start, 'group'] <<- closest_group 
    } else { 
     df[df$start == cur_start, 'group'] <<- closest_group + 1 
    } 
    }) 

    return(df) 
} 

Answer 1

これは、dplyrで比較的簡単に実行できます。 A -

1. ラグ端データが
2. 開始日および「ブレークポイント」を追加遅れ終了日
3. との間の差を計算する（いずれかでそれをダウンシフト）：

   考え方は以下であります差が5日を超えるとTRUEになり、それ以外の場合はFALSEになります。

4. このブレークポイントの累積合計を計算します。

   df %>% 
       mutate(lagged_end = lag(end), 
        diff = start - lagged_end, 
        new_interval = diff > 5, 
        new_interval = ifelse(is.na(new_interval), FALSE, new_interval), 
        interval_number = cumsum(new_interval)) 
   

   それはすべてdplyrにありますので、これはまた、非常に迅速でなければなりません：これは1に新しい間隔がこのような何かがあなたのために働く必要があり

を開始する必要がありますので、それは新しいブレークポイントを見つけるたびに追加されます

Answer 2

これはロレンツォロッシの溶液ほどエレガントではなく、コードのcut.Dateと2行用いてわずかに異なるアプローチを提供する：

breakpoints <- c(FALSE, sapply(2:nrow(df), function(x) df[x,"start"] - df[x-1,"end"]) > 5) 
clusterLabels <- as.numeric(cut.Date(df$start, c(min(df$start), df[breakpoints, "start"], max(df$start)+1))) 

を