2017-10-19 4 views
1
私は現在、次のデータ構造を取り扱っております

マッチング値

ID Begin_A  End_A  Interval       Value 
1 5 1990-03-01 2017-03-10 1990-03-01 UTC--2017-03-10 UTC Cat1 
2 10 1993-12-01 2017-12-02 1993-12-01 UTC--2017-12-02 UTC Cat2 
3 5 1991-03-01 2017-03-03 1991-03-01 UTC--2017-03-03 UTC Cat3 
4 10 1995-12-05 2017-12-10 1995-12-05 UTC--2017-12-10 UTC Cat4 

予約のDF:としてすでに述べた

ID Begin_A  End_A      Interval 
1 5 2017-03-03 2017-03-05 2017-03-03 UTC--2017-03-05 UTC 
2 6 2017-05-03 2017-05-05 2017-05-03 UTC--2017-05-05 UTC 
3 8 2017-03-03 2017-03-05 2017-03-03 UTC--2017-03-05 UTC 
4 10 2017-12-05 2017-12-06 2017-12-05 UTC--2017-12-06 UTC 

はDF属性次の投稿:Matching values conditioned on overlapping Intervals and ID、私は次のデータ再構成を行うつもりです:予約からIDを取得し、属性ID mの属性データフレームのすべての行をフィルタリングします予約IDを表示します。一致する属性IDを持つ行の中で、時間間隔が重複しているものを確認してください(潤滑油からのint_overlaps)。値の列からそれぞれの値を取り出し、Attribute_value列にそれぞれの値を表示します。

意図した結果は次のようになります。

ID Begin_A  End_A  Interval      Attribute_value 
5 2017-03-03 2017-03-05 2017-03-03 UTC--2017-03-05 UTC Cat1,Cat3 
6 2017-05-03 2017-05-05 2017-05-03 UTC--2017-05-05 UTC NA 
8 2017-03-03 2017-03-05 2017-03-03 UTC--2017-03-05 UTC NA 
10 2017-12-05 2017-12-06 2017-12-05 UTC--2017-12-06 UTC Cat4 

YCWはすでにここにこの質問:(https://stackoverflow.com/a/46819541/8259308)への部分的な答えを提供しました。個々の日付のベクトルは、このコマンドで作成されるため、このソリューションは、属性データフレーム内Begin_AとEnd_Aの間に長い期間を許可していません。私の元のデータセットは、長い時間と観測の非常に大規模な量を持っているので

complete(Date = full_seq(Date, period = 1), ID) %>% 

アトリビュートデータフレーム内のフレームでは、Rはこれらの大量の観測を処理することができません。私の考えは、上記の行を修正して日付のジャンプを数カ月に減らす(精度も低下する)か、新しいアプローチを試みることでした。 次のコードは、上記のデータフレームを生成します。

library(lubridate) 
library(tidyverse) 
# Attributes data frame: 
date1 <- as.Date(c('1990-3-1','1993-12-1','1991-3-1','1995-12-5')) 
date2 <- as.Date(c('2017-3-10','2017-12-2','2017-3-3','2017-12-10')) 
attributes <- data.frame(matrix(NA,nrow=4, ncol = 5)) 
names(attributes) <- c("ID","Begin_A", "End_A", "Interval", "Value") 
attributes$ID <- as.numeric(c(5,10,5,10)) 
attributes$Begin_A <-date1 
attributes$End_A <-date2 
attributes$Interval <-attributes$Begin_A %--% attributes$End_A 
attributes$Value<- as.character(c("Cat1","Cat2","Cat3","Cat4")) 

### Bookings data frame: 

date1 <- as.Date(c('2017-3-3','2017-5-3','2017-3-3','2017-12-5')) 
date2 <- as.Date(c('2017-3-5','2017-5-5','2017-3-5','2017-12-6')) 
bookings <- data.frame(matrix(NA,nrow=4, ncol = 4)) 
names(bookings) <- c("ID","Begin_A", "End_A", "Interval") 
bookings$ID <- as.numeric(c(5,6,8,10)) 
bookings$Begin_A <-date1 
bookings$End_A <-date2 
bookings$Interval <-bookings$Begin_A %--% bookings$End_A 

これはYCWによって提供前のポストのためのソリューションです:

library(tidyverse) 

attributes2 <- attributes %>% 
    select(-Interval) %>% 
    gather(Type, Date, ends_with("_A")) %>% 
    select(-Type) %>% 
    group_by(Value) %>% 
    complete(Date = full_seq(Date, period = 1), ID) %>% 
    ungroup() 

bookings2 <- bookings %>% 
    select(-Interval) %>% 
    gather(Type, Date, ends_with("_A")) %>% 
    select(-Type) %>% 
    group_by(ID) %>% 
    complete(Date = full_seq(Date, period = 1)) %>% 
    ungroup() 

bookings3 <- bookings2 %>% 
    left_join(attributes2, by = c("ID", "Date")) %>% 
    group_by(ID) %>% 
    summarise(Attribute_value = toString(sort(unique(Value)))) %>% 
    mutate(Attribute_value = ifelse(Attribute_value %in% "", NA, Attribute_value)) 

bookings4 <- bookings %>% left_join(bookings3, by = "ID") 
bookings4 
    ID Begin_A  End_A      Interval Attribute_value 
1 5 2017-03-03 2017-03-05 2017-03-03 UTC--2017-03-05 UTC  Cat1, Cat3 
2 6 2017-05-03 2017-05-05 2017-05-03 UTC--2017-05-05 UTC   <NA> 
3 8 2017-03-03 2017-03-05 2017-03-03 UTC--2017-03-05 UTC   <NA> 
4 10 2017-12-05 2017-12-06 2017-12-05 UTC--2017-12-06 UTC   Cat4 
+3

チェックアウト 'data.table :: foverlaps'。 – Mako212

答えて

1

あなたは「非エクイが参加する」を可能data.tableを考慮することができますすなわち、>=,>,<=および<に基づくジョイン。同じ呼び出しでは、RHSデータ・セット(i)の各行が(by = .EACHI)と一致するLHSデータ・セット内のグループに対して集約操作を実行できます。

d1[d2, on = .(id = id, end >= begin), 
     .(i.begin, i.end, val_str = toString(val)), by = .EACHI] 

# id  end i.begin  i.end val_str 
# 1: 5 2017-03-03 2017-03-03 2017-03-05 Cat3, Cat1 
# 2: 6 2017-05-03 2017-05-03 2017-05-05   NA 
# 3: 8 2017-03-03 2017-03-03 2017-03-05   NA 
# 4: 10 2017-12-05 2017-12-05 2017-12-06  Cat4 

データ準備:オーバーラップが参加する実行するために特別に設計されて

d1 <- data.frame(id = c(5, 10, 5, 10), 
       begin = as.Date(c('1990-3-1','1993-12-1','1991-3-1','1995-12-5')), 
       end = as.Date(c('2017-3-10','2017-12-2','2017-3-3','2017-12-10')), 
       val = c("Cat1", "Cat2", "Cat3", "Cat4")) 

d2 <- data.frame(id = c(5, 6, 8, 10), 
       begin = as.Date(c('2017-3-3','2017-5-3','2017-3-3','2017-12-5')), 
       end = as.Date(c('2017-3-5','2017-5-5','2017-3-5','2017-12-6'))) 

library(data.table) 
setDT(d1) 
setDT(d2)