在group_modify()下的case_when()中的%within%不能工作。

Question

我有以下几种数据。

library(tidyverse)
library(lubridate)


data <- tibble(a = c(1, 1, 2, 3, 3, 3, 3),
               b = c('x', 'y', 'z', 'z', 'z', 'z', 'z'),
               c = c('ps', 'ps', 'qs', 'rs', 'rs', 'rs', 'rs'),
               d = c(100, 200, 300, 400, 500, 600, 700),
               strt = ymd(c('2019-03-20', '2020-01-01', '2018-01-02', '2020-05-01', '2016-01-01', '2020-03-01', '2020-01-01')),
               fnsh = ymd(c('3019-03-20', '3020-01-01', '3018-01-02', '2020-06-01', '2016-05-01', '2020-04-01', '2020-06-10')))

我正在对变量a、b、c进行分组操作（即： data %>% group_by(a, b, c))进行分组运算，使用 group_modify(). 对于每一个组，我需要找到在过去一年内有真实起始日期的行。如果一个strt不在该组中任何其他行的strt和fnsh之间，那么它就是真实的。我目前的方法是

test <- data %>%
  group_by(a, b, c) %>%
  group_modify(function(.x, .y) {
               .x %>%
               mutate(startLatestYear = case_when(strt > today(tzone = 'CET') - years(1) &
                                                  strt <= today(tzone = 'CET') &
                                                  !strt %within% (.x %>%
                                                                  mutate(pushInterval = interval(strt + days(1), fnsh)) %>%
                                                                  select(pushInterval)) ~ 1,
                                                  TRUE ~ 0))}) %>%
  ungroup()

这个方法给出的结果是：

data <- tibble(a = c(1, 1, 2, 3, 3, 3, 3),
               b = c('x', 'y', 'z', 'z', 'z', 'z', 'z'),
               c = c('ps', 'ps', 'qs', 'rs', 'rs', 'rs', 'rs'),
               d = c(100, 200, 300, 400, 500, 600, 700),
               strt = ymd(c('2019-03-20', '2020-01-01', '2018-01-02', '2020-05-01', '2016-01-01', '2020-03-01', '2020-01-01')),
               fnsh = ymd(c('3019-03-20', '3020-01-01', '3018-01-02', '2020-06-01', '2016-05-01', '2020-04-01', '2020-06-10')),
               startLatestYear = c(0, 1, 0, 1, 0, 1, 1))

需要的是：

data <- tibble(a = c(1, 1, 2, 3, 3, 3, 3),
               b = c('x', 'y', 'z', 'z', 'z', 'z', 'z'),
               c = c('ps', 'ps', 'qs', 'rs', 'rs', 'rs', 'rs'),
               d = c(100, 200, 300, 400, 500, 600, 700),
               strt = ymd(c('2019-03-20', '2020-01-01', '2018-01-02', '2020-05-01', '2016-01-01', '2020-03-01', '2020-01-01')),
               fnsh = ymd(c('3019-03-20', '3020-01-01', '3018-01-02', '2020-06-01', '2016-05-01', '2020-04-01', '2020-06-10')),
               startLatestYear = c(0, 1, 0, 0, 0, 0, 1))

这个组的基础是 a == 3, b == 'z' 和 c == 'rs' 中有一行（最后一行）应该是组中唯一在startLatestYear中含有1的行。最后一行是该组中唯一的一行，它的strt在最近一年内，而strt在该组中其他行的间隔之外。

目前使用的前两个条件是 case_when() 似乎是有效的。第三个条件是使用 %within% 似乎并不奏效。怎么能用 %within% 来工作？或者说如何实现其他解决方案？

PS：我已经尝试过在分组tibble之前做pushInterval。这样做会产生相同的startLatestYear列，但操作会导致 "问题 "的出现。bind_rows_() 剥离了时间间隔属性。因此，目前的解决方案是在飞行中产生pushInterval。

Answer 1

我觉得你不需要用 group_modify这在一个简单的组中工作 mutate:

data %>%
  group_by(a, b, c) %>%
  mutate(x = +(purrr::map_lgl(strt, ~ sum(strt <= .x & .x <= fnsh) < 2) &
                 difftime(Sys.time(), strt, "days") < 365)) %>%
  ungroup()
# # A tibble: 7 x 7
#       a b     c         d strt       fnsh           x
#   <dbl> <chr> <chr> <dbl> <date>     <date>     <int>
# 1     1 x     ps      100 2019-03-20 3019-03-20     0
# 2     1 y     ps      200 2020-01-01 3020-01-01     1
# 3     2 z     qs      300 2018-01-02 3018-01-02     0
# 4     3 z     rs      400 2020-05-01 2020-06-01     0
# 5     3 z     rs      500 2016-01-01 2016-05-01     0
# 6     3 z     rs      600 2020-03-01 2020-04-01     0
# 7     3 z     rs      700 2020-01-01 2020-06-10     1

.x 是作为第一个参数传递给 map_lgl. 在这种情况下，它也是 strt但我们先不说这个。

里面的tilde函数。strt 指的是整个向量，而 .x 是指每个人 strt 值（它总是长度为1）。strt <= .x 第一次实际上是 strt <= strt[1]. 该 sum 只是计算有多少次出现是真的。一个因为一个数字总是在它自己的范围内）。)