r - 当我使用滞后函数时，如何将前一行中的 "skip"日期与当前行中的日期相同？

Question

我有一个包含“人员”、“NoShow”和“日期”列的数据框。

  Person NoShow       date
1    334      1 2019-07-07
2    334      1 2019-10-11
3    334      1 2020-07-07
4    334      1 2021-01-04
5    999      1 2021-06-03
6    999      1 2022-04-17
7    999      1 2022-05-03
8    999      0 2022-05-03

创建数据框的代码:

df <- data.frame(Person = c('334','334','334','334','999','999','999','999'), 
                 NoShow = c(1,1,1,1,1,1,1,0), 
                 date = c('2019-07-07','2019-10-11','2020-07-07','2021-01-04','2021-06-03','2022-04-17','2022-05-03','2022-05-03')
)

我运行以下代码来创建三个新列:(1) 'prior_noshow'，指示一个人是否错过了之前的任何约会； (2) 'prior_noshow_f'，表示一个人之前错过的约会次数； (3) 'last_noshow'，表示某人最后一次错过过去的约会。

library(tidyverse)
df <- df %>% 
  group_by(Person) %>%
  mutate(prior_noshow = lag(as.numeric(cumsum(NoShow) > 0)),
         prior_noshow_f = lag(cumsum(NoShow)))

df$prior_noshow_f[is.na(df$prior_noshow_f)] <- 0

df <- df %>% 
  group_by(Person) %>%
  mutate(last_noshow = ifelse(c(FALSE, diff(prior_noshow_f))!= 0, lag(date), NA)) %>%
  fill(last_noshow)

这将创建以下输出:

  Person NoShow date       prior_noshow prior_noshow_f last_noshow
  <chr>   <dbl> <chr>             <dbl>          <dbl> <chr>      
1 334         1 2019-07-07           NA              0 NA         
2 334         1 2019-10-11            1              1 2019-07-07 
3 334         1 2020-07-07            1              2 2019-10-11 
4 334         1 2021-01-04            1              3 2020-07-07 
5 999         1 2021-06-03           NA              0 NA         
6 999         1 2022-04-17            1              1 2021-06-03 
7 999         1 2022-05-03            1              2 2022-04-17 
8 999         0 2022-05-03            1              3 2022-05-03

但是，当当前日期比上一行中的日期晚时，我只想将其视为“之前未出现”。因此，第 8 行应该有 'prior_noshow_f'==2 和 'last_noshow'==2022-04-17，因为第 7 行和第 8 行具有相同的日期 (2022-05-03)。

我该怎么做？

Answer 1

尝试以下操作。
将 prior_noshow_f 的值乘以逻辑判断日期是否与前一个日期不同。这会将零放在它们相等的地方。然后用前一个日期替换零，并注意 NA。

关于日期last_noshow，如果每组Person和prior_noshow_f有多行，则日期应该是日期上一组。这是通过分配 NA 然后填充以前的非 NA 值来处理的。

df <- data.frame(Person = c('334','334','334','334','999','999','999','999'), 
                 NoShow = c(1,1,1,1,1,1,1,0), 
                 date = c('2019-07-07','2019-10-11','2020-07-07','2021-01-04','2021-06-03','2022-04-17','2022-05-03','2022-05-03')
                 )

suppressPackageStartupMessages(
  library(tidyverse)
)

df %>% 
  group_by(Person) %>%
  mutate(prior_noshow = lag(as.numeric(cumsum(NoShow) > 0)),
         prior_noshow_f = lag(cumsum(NoShow), default = 0)*(date != lag(date)),
         prior_noshow_f = case_when(
           is.na(prior_noshow_f) ~ 0,
           prior_noshow_f == 0 ~ lag(prior_noshow_f),
           TRUE ~ prior_noshow_f
         )) %>%
  group_by(Person, prior_noshow_f) %>%
  mutate(last_noshow = ifelse(n() > 1, NA, date)) %>%
  group_by(Person) %>%
  mutate(last_noshow = zoo::na.locf(last_noshow)) %>%
  ungroup()
#> # A tibble: 8 × 6
#>   Person NoShow date       prior_noshow prior_noshow_f last_noshow
#>   <chr>   <dbl> <chr>             <dbl>          <dbl> <chr>      
#> 1 334         1 2019-07-07           NA              0 2019-07-07 
#> 2 334         1 2019-10-11            1              1 2019-10-11 
#> 3 334         1 2020-07-07            1              2 2020-07-07 
#> 4 334         1 2021-01-04            1              3 2021-01-04 
#> 5 999         1 2021-06-03           NA              0 2021-06-03 
#> 6 999         1 2022-04-17            1              1 2022-04-17 
#> 7 999         1 2022-05-03            1              2 2022-04-17 
#> 8 999         0 2022-05-03            1              2 2022-04-17

^{由 reprex package 创建于 2022-08-23 (v2.0.1)}