问题描述
我想为数据中的每个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
方法有什么问题?
解决方法
使用dplyr
,lubridate
和purrr
的一个选项可能是:
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.