Dplyr/Lubridate：如何汇总分组后的重叠区间

Question

我想对协议进行分组，然后比较它们的周期有多少重叠（或分开）。

我的数据框可能如下所示：

library(tidyverse)
library(lubridate)

tribble(
~ShipTo,    ~Code,  ~Start, ~End,
"xxxx", "AAA11",    2018-01-01, 2018-03-01,
"yyyy", "BBB23",    2018-02-01, 2018-05-11,
"yyyy", "BBB23",    2018-03-01, 2018-06-11,
"cccc", "AAA11",    2018-01-06, 2018-03-12,
"yyyy", "CCC04",    2018-01-16, 2018-03-31,
"xxxx", "DDD",    2018-01-21,   2018-03-25
)

我想改变一列以创建润滑周期并在按 ShipTo 和代码分组后对其进行评估。我尝试的是：

dft3<-dft %>% filter(concat1 %in% to_filter2)  %>%
  arrange(ShipTo,Code)%>% 
  group_by(ShipTo,Code)%>%
  mutate(period=interval(Start,End), 
         nextperiod=interval(lead(Start),lead(End)),
         interv=day(as.period(intersect(period, nextperiod), "days"))) %>%
  group_by(ShipTo,Code)%>%
  summarise(count=n(),
    intervmax=max(interv),
    intervmin=min(interv))

如果我删除 group_by(ShipTo,Code)%>% 行，则会正确创建间隔，并且还会从下一行正确计算提前期间隔。但是当我天真地使用group_by时，间隔计算不正确。

我怀疑也许我的数据库应该按组分成许多 table，然后，在创建和比较间隔的操作之后，应该将它们粘在一起。

有什么简洁的方法吗？或者也许还有更简单的方法我还没有学会？预先感谢您在正确方向上的提示。

编辑：所需的输出应该是一列，其中包含以天为单位的间隔重叠值（如果没有重叠，则为间隔之间的距离）。分组会破坏计算。我想在组内计算这些值（而不是跨组）。

EDIT2：我试图通过将数据帧拆分为数据帧列表然后将其组合来解决问题，但我不确定语法。它不太有效，在一列中生成 tables，这是我在其他门户网站上获得的帮助（也许它可以说明问题）。这个想法是拆分数据库，创建新列并将 table 组合成单个 table.

    fnOverlaps <- function(x) {

      mutate(x,okres=interval(Start,End),
             nastokres=interval(lead(Start),lead(End)), 
             interv=day(as.period(intersect(okres, nastokres), "days"))) 
    }

dft3<-dft3 %>% 
  split(list(.$ShipTo, .$Code), drop = TRUE)  %>%   
  map_df(fnOverlaps) %>% 
  flatten_dfr()

我期望的结果（对于一组）如下所示。

tribble(
~ShipTo,    ~Code,  ~interv,    
"yyyy", "BBB23",    70        #say there is a 70 days overlap
"yyyy", "BBB23",    NA        #there is no next row to compare

)

Answer 1

问题似乎是由尝试将向量与 class "Interval." 组合引起的。具体来说，它们似乎正在转换为数字并丢失其固有信息。

我认为唯一可行的解决方案是 split data.frame、运行分别用 lapply 对每个组件进行分析，然后用 bind_rows。当删除 NA 后参数为空时，只有一个条目的组数会出现 max 和 min return -Inf 和 Inf 的问题。但是，这很容易纠正。

此代码应该有效。请注意，我使用 group_by 来确保保留 ShipTo/Code 列，尽管您可以通过其他方式做到这一点。

dft %>%
  split(paste(.$ShipTo, "XXX", .$Code)) %>%
  lapply(function(x){
    x %>%
      arrange(ShipTo,Code) %>% 
      mutate(period=interval(Start,End)
             , nextperiod=interval(lead(Start),lead(End))
             , interv=day(as.period(intersect(period, nextperiod), "days"))
      ) %>%
      group_by(ShipTo,Code)%>%
      summarise(count=n(),
                intervmax=max(interv, na.rm = TRUE),
                intervmin=min(interv, na.rm = TRUE)) %>%
      ungroup()
  }) %>%
  bind_rows() %>%
  mutate(intervmax = ifelse(is.infinite(intervmax)
                            , NA, intervmax)
         , intervmin = ifelse(is.infinite(intervmin)
                              , NA, intervmin))

Returns

# A tibble: 5 x 5
  ShipTo Code  count intervmax intervmin
  <chr>  <chr> <int>     <dbl>     <dbl>
1 cccc   AAA11     1      NA        NA  
2 xxxx   AAA11     1      NA        NA  
3 xxxx   DDD       1      NA        NA  
4 yyyy   BBB23     2      71.0      71.0
5 yyyy   CCC04     1      NA        NA

Answer 2

我只是为了记录一下。我收到了 Jake Knaupp 对 slack r4ds 组的回答，使用现代 map_df() 语法，它计算周期的重叠，但 它将周期转换为数字。它会发出一堆警告。

myFun <- function(x) {

  mutate(x,period=interval(Start,End),
       nextperiod=interval(lead(Start),lead(End)), 
       interv=day(as.period(intersect(period, nextperiod), "days"))) 
  }

df %>% 
  split(list(.$ShipTo, .$Code), drop = TRUE) %>% 
  map_df(myFun)

Dplyr/Lubridate：如何汇总分组后的重叠区间

Dplyr/Lubridate: How to summarise overlapping intervals after grouping

r

lubridate

dplyr