时间戳

首页 > 解决方案 > group_modify() 下的 case_when() 中的 %within% 不起作用

r - group_modify() 下的 case_when() 中的 %within% 不起作用

问题描述

我有以下类型的数据：

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 的解决方案是动态的。

标签： rdplyrlubridate

解决方案

我认为您不需要使用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，但让我们暂时忘记它。

在波浪号函数内部，strt指的是整个向量，并且.x指的是每个单独的strt值（长度始终为 1）。strt <= .x第一次是有效的strt <= strt[1]。只是计算有sum多少事件是真实的。（应该总是有一个，因为一个数字总是在它自己的范围内。）

推荐阅读