如何在R中的非连续行中重复删除日期序列?

问题描述

我想为数据中的每个id标记至少31天的每个窗口中的第一个日期。
数据:

library(tidyverse)
library(lubridate)
library(tibbletime)

D1 <- tibble(id = c(12,12,10,10),index_date=c("2019-01-01","2019-01-07","2019-01-21","2019-02-02","2019-02-09","2019-03-06","2019-01-05","2019-02-01","2019-02-08"))
D1

# A tibble: 10 x 2
      id index_date
   <dbl> <chr>     
 1    12 2019-01-01
 2    12 2019-01-07
 3    12 2019-01-21
 4    12 2019-02-02
 5    12 2019-02-09
 6    12 2019-03-06
 7    10 2019-01-05
 8    10 2019-02-01
 9    10 2019-02-02
10    10 2019-02-08

标记的行是行1、4、6、7和10;这些行代表给定index_date的第一个id或从给定index_date的先前标记index_date起31天跳过期后的第一个id }。
代码

temp <- D1 %>%
  mutate(index_date = ymd(index_date)) %>%  
  arrange(id,index_date) %>%
  as_tbl_time(index_date) %>% 
  group_by(id) %>%
  mutate(keyed_to_index_date = 
           collapse_index(index_date,period = '31 d',side = "start"),keep = index_date == keyed_to_index_date)
temp %>% arrange(desc(id),index_date)

结果:

      id index_date keyed_to_index_date keep       
   <dbl> <date>     <date>              <lgl>
 1    12 2019-01-01 2019-01-01          TRUE 
 2    12 2019-01-07 2019-01-01          FALSE
 3    12 2019-01-21 2019-01-01          FALSE
 4    12 2019-02-02 2019-02-02          TRUE 
 5    12 2019-02-09 2019-02-02          FALSE
 6    12 2019-03-06 2019-03-06          TRUE 
 7    10 2019-01-05 2019-01-05          TRUE 
 8    10 2019-02-01 2019-02-01          TRUE 
 9    10 2019-02-02 2019-02-01          FALSE
10    10 2019-02-08 2019-02-01          FALSE

为什么此代码标记第8行(在先前为该index_date标记index_date的{​​{1}}之后的31天之内)而不是第10行,我该如何解决这个问题吗?

更新:
根据@ mnaR99的建议,将选项id添加start_date = first(index_date),成功标记了原始示例中的正确行。但是,当我对新数据应用相同的原理时,我遇到了一个问题:
数据:

collapse_index()

现在,我希望以与以前应用31天的窗口相同的方式应用2天的窗口(也就是说,不应同时标记连续的日历日)。需要标记的行是行1、3、4、6、8、9和11,因为这些行是特定“ id”的第一个“ index_date”,或者是跳过两天后的第一个
码:
D2 <- tibble(id = c("A","A","B","C","C"),index_date = c("2019-03-04","2019-03-05","2019-03-01","2019-03-02","2019-03-04","2019-03-03","2019-03-05"))

D2
   id    index_date
   <chr> <chr>     
 1 A     2019-03-04
 2 A     2019-03-05
 3 A     2019-03-06
 4 B     2019-03-01
 5 B     2019-03-02
 6 B     2019-03-04
 7 B     2019-03-05
 8 B     2019-03-06
 9 C     2019-03-03
10 C     2019-03-04
11 C     2019-03-05

结果:

t3 <- D2 %>%
  mutate(index_date = ymd(index_date)) %>%  
  arrange(id,period = '2 d',side = "start",start_date = first(index_date)),keep = index_date == keyed_to_index_date) %>%
  arrange(id,index_date)

第7行被错误标记为TRUE,而第8行被错误标记为FALSE。
当我应用@tmfmnk建议的> t3 # A time tibble: 11 x 4 # Index: index_date # Groups: id [3] id index_date keyed_to_index_date keep <chr> <date> <date> <lgl> 1 A 2019-03-04 2019-03-04 TRUE 2 A 2019-03-05 2019-03-04 FALSE 3 A 2019-03-06 2019-03-06 TRUE 4 B 2019-03-01 2019-03-01 TRUE 5 B 2019-03-02 2019-03-01 FALSE 6 B 2019-03-04 2019-03-04 TRUE 7 B 2019-03-05 2019-03-05 TRUE 8 B 2019-03-06 2019-03-05 FALSE 9 C 2019-03-03 2019-03-03 TRUE 10 C 2019-03-04 2019-03-03 FALSE 11 C 2019-03-05 2019-03-05 TRUE 解决方案时,我得到了正确的结果。
代码

purrr

结果:

t4 <-
  D2 %>%
  group_by(id) %>%
  mutate(index_date = ymd(index_date),keep =  row_number() == 1 | 
           accumulate(c(0,diff(index_date)),~ if_else(.x >= 2,.y,.x + .y)
           ) >= 2
  )

在此示例中,> t4 # A tibble: 11 x 3 # Groups: id [3] id index_date keep <chr> <date> <lgl> 1 A 2019-03-04 TRUE 2 A 2019-03-05 FALSE 3 A 2019-03-06 TRUE 4 B 2019-03-01 TRUE 5 B 2019-03-02 FALSE 6 B 2019-03-04 TRUE 7 B 2019-03-05 FALSE 8 B 2019-03-06 TRUE 9 C 2019-03-03 TRUE 10 C 2019-03-04 FALSE 11 C 2019-03-05 TRUE 方法有什么问题?

解决方法

使用dplyrlubridatepurrr的一个选项可能是:

D1 %>%
 group_by(id) %>%
 mutate(index_date = ymd(index_date),keep =  row_number() == 1 | accumulate(c(0,diff(index_date)),~ if_else(.x >= 31,.y,.x + .y)) >= 31)

     id index_date keep 
   <dbl> <date>     <lgl>
 1    12 2019-01-01 TRUE 
 2    12 2019-01-07 FALSE
 3    12 2019-01-21 FALSE
 4    12 2019-02-02 TRUE 
 5    12 2019-02-09 FALSE
 6    12 2019-03-06 TRUE 
 7    10 2019-01-05 TRUE 
 8    10 2019-02-01 FALSE
 9    10 2019-02-02 FALSE
10    10 2019-02-08 TRUE 
,

您只需要将start_date参数添加到collapse_index

D1 %>%
  mutate(index_date = ymd(index_date)) %>%  
  arrange(id,index_date) %>%
  as_tbl_time(index_date) %>% 
  group_by(id) %>%
  mutate(keyed_to_index_date = 
           collapse_index(index_date,period = '31 d',side = "start",start_date = first(index_date)),keep = index_date == keyed_to_index_date) %>% 
  arrange(desc(id),index_date)
#> # A time tibble: 10 x 4
#> # Index:  index_date
#> # Groups: id [2]
#>       id index_date keyed_to_index_date keep 
#>    <dbl> <date>     <date>              <lgl>
#>  1    12 2019-01-01 2019-01-01          TRUE 
#>  2    12 2019-01-07 2019-01-01          FALSE
#>  3    12 2019-01-21 2019-01-01          FALSE
#>  4    12 2019-02-02 2019-02-02          TRUE 
#>  5    12 2019-02-09 2019-02-02          FALSE
#>  6    12 2019-03-06 2019-03-06          TRUE 
#>  7    10 2019-01-05 2019-01-05          TRUE 
#>  8    10 2019-02-01 2019-01-05          FALSE
#>  9    10 2019-02-02 2019-01-05          FALSE
#> 10    10 2019-02-08 2019-02-08          TRUE

reprex package(v0.3.0)于2020-09-11创建

,

您可以使用accumulate()中的purrr

D1 %>%
  group_by(id) %>% 
  mutate(index_date = ymd(index_date),keep = index_date == accumulate(index_date,~ if(.y - .x >= 31) .y else .x))

#       id index_date keep 
#    <dbl> <date>     <lgl>
#  1    12 2019-01-01 TRUE 
#  2    12 2019-01-07 FALSE
#  3    12 2019-01-21 FALSE
#  4    12 2019-02-02 TRUE 
#  5    12 2019-02-09 FALSE
#  6    12 2019-03-06 TRUE 
#  7    10 2019-01-05 TRUE 
#  8    10 2019-02-01 FALSE
#  9    10 2019-02-02 FALSE
# 10    10 2019-02-08 TRUE

迭代规则如下:

1. 2019-01-07 -  2019-01-01   = 6  <  31 then return  2019-01-01
2. 2019-01-21 -  2019-01-01   = 20 <  31 then return  2019-01-01
3. 2019-02-02 -  2019-01-01   = 32 >= 31 then return (2019-02-02)*
4. 2019-02-09 - (2019-02-02)* = 7  <  31 then return  2019-02-02
5. etc.