2017-08-31 4 views
1

自分で作成したものではないにしても、数週間前にStackOverflowで寛大な回答者から受け取った素敵なコードで解決するのは難しいバグです。今日は新しい援助を使うことができます。日付でデータフレームをグループ化する:不足している期間を解決するバグ

サンプルデータ(以下と呼ばれるオブジェクトeh):

ID  2013-03-20 2013-04-09 2013-04-11 2013-04-17 2013-04-25 2013-05-15 2013-05-24 2013-05-25 2013-05-26 
    5167f   0   0   0   0   0   0   0   0   0 
    1214m   0   0   0   0   0   0   0   0   0 
    1844f   0   0   0   0   0   0   0   0   0 
    2113m   0   0   0   0   0   0   0   0   0 
    2254m   0   0   0   0   0   0   0   0   0 
    2721f   0   0   0   0   0   0   0   0   0 
    3121f   0   0   0   0   0   0   0   0   0 
    3486f   0   0   0   0   0   0   0   0   0 
    3540f   0   0   0   0   0   0   0   0   0 
    4175m   0   0   0   0   0   0   0   0   0 

Iは、それぞれの列の日付が属する時間帯(例えば、毎1、2、3でグループ0s1sできるようにする必要、または4週間)。 1が特定の日付範囲(Period)内に少なくとも1回落ちる場合は、(0)の中に1が集計されます。

私は例として1週間のサマリールーチンから始めます。私の主な問題は、生成された最終的な出力は、"2013-03-20"から"2015-12-31"までの間に可能な合計1週間のPeriodsの一部が欠落していることです。 Periods 2、5、7、および9が欠落しているかの行がIDsユニークとしており、列はユニークPeriodsするためのものである。この例の出力は、中

注意:ここで

1 3 4 6 8 10 11 12 13 14 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 
    0 0 0 0 0 0 0 0 0 0 

はのための完全なルーチンです元のデータフレームをグループ化する(上記の共有のサンプルデータを参照してください):

#Convert to data table from original data frame, eh 
    dt <- as.data.table(eh) 

    #One week summarized encounter histories 
    dt_merge <- data_frame(
     # Create a column showing the beginning date 
     Date1 = seq(from = ymd("2013-03-20"), to = ymd("2015-12-31"), by = "1 week")) %>% 
     # Create a column showing the end date of each period 
     mutate(Date2 = lead(Date1)) %>% 
     # Adjust Date1 
     mutate(Date1 = if_else(Date1 == ymd("2013-03-20"), Date1, Date1 + 1)) %>% 
     # Remove the last row 
     drop_na(Date2) %>% 
     # Create date list 
     mutate(Dates = map2(Date1, Date2, function(x, y){ seq(x, y, by = "day") })) %>% 
     unnest() %>% 
     # Create Group ID 
     mutate(RunID = group_indices_(., dots. = c("Date1", "Date2"))) %>% 
     # Create Period ID 
     mutate(Period = paste0(RunID)) %>% 
     # Add a column showing Month 
     mutate(Month = month(Dates)) %>% 
     # Add a column showing Year 
     mutate(Year = year(Dates)) %>% 
     # Add a column showing season 
     mutate(Season = case_when(
     Month %in% 3:5   ~ "Spring", 
     Month %in% 6:8   ~ "Summer", 
     Month %in% 9:11   ~ "Fall", 
     Month %in% c(12, 1, 2) ~ "Winter", 
     TRUE      ~ NA_character_ 
    )) %>% 
     # Combine Season and Year 
     mutate(SeasonYear = paste0(Season, Year)) %>% 
     select(-Date1, -Date2, -RunID) 
    dt2 <- dt %>% 
     # Reshape the data frame 
     gather(Date, Value, -ID) %>% 
     # Convert Date to date class 
     mutate(Date = ymd(Date)) %>% 
     # Join dt_merge 
     left_join(dt_merge, by = c("Date" = "Dates")) 
    one.week <- dt2 %>% 
     group_by(ID, Period) %>% 
     summarise(Value = max(Value)) %>% 
     spread(Period, Value) 

    #Finished product 
    one.week <- as.data.frame(one.week) 

    #Missing weeks 2, 5, 7, and 9... 
    one.week 

は、誰かが私が間違って行ってきたところ、私が理解するのに役立ちます

?前もって感謝します!

〜AD

答えて

2

それら週間ehデータから欠落しているので、これが起こっています。あなたは週に2を構成する日付を見ればたとえば、:

dt_merge %>% 
    filter(Period == 2) 
#> # A tibble: 7 x 6 
#>  Dates Period Month Year Season SeasonYear 
#>  <date> <chr> <dbl> <dbl> <chr>  <chr> 
#> 1 2013-03-28  2  3 2013 Spring Spring2013 
#> 2 2013-03-29  2  3 2013 Spring Spring2013 
#> 3 2013-03-30  2  3 2013 Spring Spring2013 
#> 4 2013-03-31  2  3 2013 Spring Spring2013 
#> 5 2013-04-01  2  4 2013 Spring Spring2013 
#> 6 2013-04-02  2  4 2013 Spring Spring2013 
#> 7 2013-04-03  2  4 2013 Spring Spring2013 

あなたはこれらの日付はいずれも2013-04-に2013年3月20日からスキップehの列、でていないことがわかります09。 dt2を作成するときにleft_joinを使用するため、ehの日付(したがって週)のみが保持されます。

tidyrパッケージのcomplete()パッケージを使用して、IDと日付の不足している組み合わせを作成することによってこれを修正できます。そのIDには値が与えられた週でなかった場合

ここ
dt2 <- dt %>% 
    # Reshape the data frame 
    gather(Date, Value, -ID) %>% 
    # Convert Date to date class 
    mutate(Date = ymd(Date)) %>% 
    # Create missing ID/Date combinations 
    complete(ID, Date = dt_merge$Dates) %>% 
    # Join dt_merge 
    left_join(dt_merge, by = c("Date" = "Dates")) 
one.week <- dt2 %>% 
    mutate(Period = as.numeric(Period)) %>% 
    group_by(ID, Period) %>% 
    summarise(Value = max(Value, na.rm = TRUE)) %>% 
    spread(Period, Value) 
one.week 
#> # A tibble: 10 x 146 
#> # Groups: ID [10] 
#>  ID `1` `2` `3` `4` `5` `6` `7` `8` `9` `10` `11` 
#> * <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> 
#> 1 1214m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 2 1844f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 3 2113m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 4 2254m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 5 2721f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 6 3121f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 7 3486f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 8 3540f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 9 4175m  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> 10 5167f  0 -Inf  0  0 -Inf  0 -Inf  0 -Inf  0 -Inf 
#> # ... with 134 more variables: `12` <dbl>, `13` <dbl>, `14` <dbl>, 
#> # `15` <dbl>, `16` <dbl>, `17` <dbl>, `18` <dbl>, `19` <dbl>, 
#> # `20` <dbl>, `21` <dbl>, `22` <dbl>, `23` <dbl>, `24` <dbl>, 
#> # `25` <dbl>, `26` <dbl>, `27` <dbl>, `28` <dbl>, `29` <dbl>, 
#> # `30` <dbl>, `31` <dbl>, `32` <dbl>, `33` <dbl>, `34` <dbl>, 
#> # `35` <dbl>, `36` <dbl>, `37` <dbl>, `38` <dbl>, `39` <dbl>, 
#> # `40` <dbl>, `41` <dbl>, `42` <dbl>, `43` <dbl>, `44` <dbl>, 
#> # `45` <dbl>, `46` <dbl>, `47` <dbl>, `48` <dbl>, `49` <dbl>, 
#> # `50` <dbl>, `51` <dbl>, `52` <dbl>, `53` <dbl>, `54` <dbl>, 
#> # `55` <dbl>, `56` <dbl>, `57` <dbl>, `58` <dbl>, `59` <dbl>, 
#> # `60` <dbl>, `61` <dbl>, `62` <dbl>, `63` <dbl>, `64` <dbl>, 
#> # `65` <dbl>, `66` <dbl>, `67` <dbl>, `68` <dbl>, `69` <dbl>, 
#> # `70` <dbl>, `71` <dbl>, `72` <dbl>, `73` <dbl>, `74` <dbl>, 
#> # `75` <dbl>, `76` <dbl>, `77` <dbl>, `78` <dbl>, `79` <dbl>, 
#> # `80` <dbl>, `81` <dbl>, `82` <dbl>, `83` <dbl>, `84` <dbl>, 
#> # `85` <dbl>, `86` <dbl>, `87` <dbl>, `88` <dbl>, `89` <dbl>, 
#> # `90` <dbl>, `91` <dbl>, `92` <dbl>, `93` <dbl>, `94` <dbl>, 
#> # `95` <dbl>, `96` <dbl>, `97` <dbl>, `98` <dbl>, `99` <dbl>, 
#> # `100` <dbl>, `101` <dbl>, `102` <dbl>, `103` <dbl>, `104` <dbl>, 
#> # `105` <dbl>, `106` <dbl>, `107` <dbl>, `108` <dbl>, `109` <dbl>, 
#> # `110` <dbl>, `111` <dbl>, ... 

-Infが返されます。あるいは、欠損値をNAで満たす代わりに、complete(ID, Date = dt_merge$Dates, fill = list(Value = 0))を使用して、それらを例えば0で埋めてもよい。これにより、観察されていないIDと日付の組み合わせのいずれかのValue変数が0になります。

+0

これはそれです。どうもありがとうございました! – Andrew

関連する問題