r-计算日期滞后

Question

我有一个形状为的数据帧

date       date_lag test_date 
<date>        <dbl> <date>    
1 2018-12-01       NA 2018-12-01
2 2019-03-01       90 2019-03-01
3 2019-05-01       61 2019-03-01
4 2020-03-10      314 2020-03-10
5 2020-03-16        6 2020-03-10
6 2020-03-23        7 2020-03-16
7 2020-03-24        1 2020-03-23

为了创建CCD_ 1&test_date，我应用了这个代码：

lag <- lag %>%
mutate(date_lag = as.numeric(date - lag(date), units="days")) %>%
mutate(test_date = case_when(
is.na(date_lag) ~ date,
date_lag < 69 ~ date-date_lag,
TRUE ~ date)) 

如果日期间隔不到69天，我希望它们的日期相同。我的代码的问题是，如果你看到第6列，我不希望它有第5列的日期，而是第4列的日期。因为date_lag与前一列的间隔仍然不到69天，这意味着我想要的数据看起来像：

date       date_lag test_date 
<date>        <dbl> <date>    
1 2018-12-01       NA 2018-12-01
2 2019-03-01       90 2019-03-01
3 2019-05-01       61 2019-03-01
4 2020-03-10      314 2020-03-10
5 2020-03-16        6 2020-03-10
6 2020-03-23        7 2020-03-10
7 2020-03-24        1 2020-03-10

提前谢谢。

Answer 1

遍历日期。对于每个日期，计算与所有其他日期的差异。利用这些差异，找到离索引日期不到69天的最早日期。

library(dplyr)
library(purrr)
library(lubridate)
# example data
date_df <- tibble(
date = ymd("2018-12-01", "2019-03-01", "2019-05-01", "2020-03-10", 
"2020-03-16", "2020-03-23", "2020-03-24")
)
earliest_within <- function(dates, n) {
map(dates, ~ min(dates[.x - dates < n])) %>% 
unlist() %>% 
as_date()
}
date_df %>%
mutate(test_date = earliest_within(date, 69))
#> # A tibble: 7 × 2
#>   date       test_date 
#>   <date>     <date>    
#> 1 2018-12-01 2018-12-01
#> 2 2019-03-01 2019-03-01
#> 3 2019-05-01 2019-03-01
#> 4 2020-03-10 2020-03-10
#> 5 2020-03-16 2020-03-10
#> 6 2020-03-23 2020-03-10
#> 7 2020-03-24 2020-03-10

Answer 2

data.table选项，它可能适用于更大的数据集：

library(data.table)
dat[, test_date := dat[
dat[, .(date, datem69 = date-69)],
on=.(date<=date, date>=datem69), x.date, mult="first"]
]
##         date  test_date
##1: 2018-12-01 2018-12-01
##2: 2019-03-01 2019-03-01
##3: 2019-05-01 2019-03-01
##4: 2020-03-10 2020-03-10
##5: 2020-03-16 2020-03-10
##6: 2020-03-23 2020-03-10
##7: 2020-03-24 2020-03-10

dat所在位置：

library(data.table)
dat <- fread("date
2018-12-01
2019-03-01
2019-05-01
2020-03-10
2020-03-16
2020-03-23
2020-03-24")

Answer 3

我在ifelse中使用了shift()函数，并获得了所需的输出。它向上移动指定数量的行并获取值。

library(dplyr)
library(data.table)
lag <- lag %>% 
mutate(
test_date=ifelse(date_lag > 68 | is.na(date_lag),
date,
shift(date,1))
)
lag
date date_lag  test_date
1 2018-12-01       NA 2018-12-01
2 2019-03-01       90 2019-03-01
3 2019-05-01       61 2019-03-01
4 2020-03-10      314 2020-03-10
5 2020-03-16        6 2020-03-10
6 2020-03-23        7 2020-03-16
7 2020-03-24        1 2020-03-23