Групповая выборочная сумма дат вне интервалов

Question

Этот вопрос является вариацией вопроса, заданного здесь .

У меня есть следующие данные:

library(tidyverse)
library(lubridate)

data <- tibble(a = c(1, 1, 2, 3, 3, 3, 3, 3, 3, 3, 3),
               b = c('x', 'y', 'z', 'z', 'z', 'z', 'z', 'z', 'z', 'z', 'z'),
               c = c('ps', 'ps', 'qs', 'rs', 'rs', 'rs', 'rs', 'rs', 'rs', 'rs', 'rs'),
               d = c(100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 1100),
               strt = ymd(c('2019-03-20', '2020-01-01', '2018-01-02', '2020-05-01', '2016-01-01', '2020-03-01', '2020-01-01', '2020-01-01', '2020-01-02', '2020-01-01', '2019-10-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', '2020-06-10', '2020-06-10', '2020-06-18', '2019-11-01')))

Я делаю групповое операция на основе переменных a, b и c (т.е. data %>% group_by(a, b, c)). Для каждой группы представляют интерес строки с подлинными датами начала в пределах последнего года. Строка является подлинной, если она не больше, чем strt и меньше чем или равным fn sh любой другой строки в группе. Таким образом, strt может быть подлинным, даже если в группе есть другой strt с тем же значением.

Задача состоит в том, чтобы сделать выборочную сумма подлинных strts в каждой группе. При создании этой суммы набор идентичных подлинных strts внутри группы должен считаться за один.

Следующее определяет подлинные даты начала, но не дает сумму:

library(tidyverse)

data %>%
  group_by(a, b, c) %>%
  mutate(begin = +(map_lgl(strt, ~ sum(strt < .x & .x <= fnsh) == 0) &
                   strt > today(tzone = 'CET') - years(1) &
                   strt <= today(tzone = 'CET')))

Вышеуказанное возвращает:

       a b     c         d strt       fnsh       begin
   <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
 8     3 z     rs      800 2020-01-01 2020-06-10     1
 9     3 z     rs      900 2020-01-02 2020-06-10     0
10     3 z     rs     1000 2020-01-01 2020-06-18     1
11     3 z     rs     1100 2019-10-01 2019-11-01     1

Требуется что-то вроде:

       a b     c         d strt       fnsh       groupBeginSum
   <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             2
 5     3 z     rs      500 2016-01-01 2016-05-01             2
 6     3 z     rs      600 2020-03-01 2020-04-01             2
 7     3 z     rs      700 2020-01-01 2020-06-10             2
 8     3 z     rs      800 2020-01-01 2020-06-10             2
 9     3 z     rs      900 2020-01-02 2020-06-10             2
10     3 z     rs     1000 2020-01-01 2020-06-18             2
11     3 z     rs     1100 2019-10-01 2019-11-01             2

Как сделать сумму для каждой группы, которая учитывает коллекцию идентификации тикальные подлинные улочки как одна?

Answer 1

Задача - подсчитать количество уникальных подлинных дат. Мы можем использовать n_distinct в отфильтрованном векторе strt: n_distinct(strt[genuine])

Обратите внимание, что я отказался от приведения типов столбцов genuine (называемых begin в ваших данных), как я бы для последующего преобразования в логический.

Надеюсь, это поможет:

library(tidyverse)
library(lubridate)

df %>%
  group_by(a, b, c) %>%
  mutate(genuine = map_lgl(strt, ~ sum(strt < .x & .x <= fnsh) == 0) &
                     strt > today(tzone = 'CET') - years(1) &
                     strt <= today(tzone = 'CET'),
         groupBeginSum = n_distinct(strt[genuine]))
#> # A tibble: 11 x 8
#> # Groups:   a, b, c [4]
#>        a b     c         d strt       fnsh       genuine groupBeginSum
#>    <dbl> <chr> <chr> <dbl> <date>     <date>     <lgl>         <int>
#>  1     1 x     ps      100 2019-03-20 3019-03-20 FALSE             0
#>  2     1 y     ps      200 2020-01-01 3020-01-01 TRUE              1
#>  3     2 z     qs      300 2018-01-02 3018-01-02 FALSE             0
#>  4     3 z     rs      400 2020-05-01 2020-06-01 FALSE             2
#>  5     3 z     rs      500 2016-01-01 2016-05-01 FALSE             2
#>  6     3 z     rs      600 2020-03-01 2020-04-01 FALSE             2
#>  7     3 z     rs      700 2020-01-01 2020-06-10 TRUE              2
#>  8     3 z     rs      800 2020-01-01 2020-06-10 TRUE              2
#>  9     3 z     rs      900 2020-01-02 2020-06-10 FALSE             2
#> 10     3 z     rs     1000 2020-01-01 2020-06-18 TRUE              2
#> 11     3 z     rs     1100 2019-10-01 2019-11-01 TRUE              2

^{Создано 18.06.2020 пакетом REPEX (v0. 3.0)}

Данные:

df <- tibble(a = c(1, 1, 2, 3, 3, 3, 3, 3, 3, 3, 3),
             b = c('x', 'y', 'z', 'z', 'z', 'z', 'z', 'z', 'z', 'z', 'z'),
             c = c('ps', 'ps', 'qs', 'rs', 'rs', 'rs', 'rs', 'rs', 'rs', 'rs', 'rs'),
             d = c(100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 1100),
             strt = ymd(c('2019-03-20', '2020-01-01', '2018-01-02', '2020-05-01', '2016-01-01', '2020-03-01', '2020-01-01', '2020-01-01', '2020-01-02', '2020-01-01', '2019-10-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', '2020-06-10', '2020-06-10', '2020-06-18', '2019-11-01')))