Dplyr/Lubridate：如何在分组后总结重叠间隔答案

【问题标题】：Dplyr/Lubridate: How to summarise overlapping intervals after groupingDplyr/Lubridate：如何在分组后总结重叠间隔
【发布时间】：2018-01-22 18:13:42
【问题描述】：

我想对协议进行分组，然后比较它们的时间段重叠（或分开）的程度。

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

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 和 Code 分组后评估它们。我尝试的是：

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 时，间隔计算不正确。

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

有简洁的方法吗？或者也许有一种我还没有学过的更简单的方法？提前感谢您提供正确方向的提示。

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

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

    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

)

【问题讨论】：

到底是什么问题？以及所需的输出是什么样的？
所需的输出应该是一列，其中包含以天为单位的间隔重叠值（如果没有重叠，则为间隔之间的距离）。分组会破坏计算。我想在组内计算这些值（而不是跨组）。
在您的示例数据中，每个组只有一行。组内（对于大多数组）没有可与之比较的“下一个”行。所以，要么：您的示例数据没有显示完整的问题（在这种情况下，请更新数据），或者您没有正确说明您的意图（例如，您想要与下一行进行比较，而不考虑组，但想要由小组总结。通过显示您希望从示例数据中获得的结果（并修复示例代码以省略示例数据中不存在的列 - 特别是 filter 步骤），这两个问题都会得到帮助
@MarkPeterson 我想比较组内的行，例如：对于行“yyyy”、“BBB23”、2018-02-01、2018-05-11 和“yyyy”、“BBB23” ", 2018-03-01, 2018-06-11, 我有几天的重叠。我想要一个“interv”列，其中包含以天为单位的重叠值。可能是这样，有效结果将仅适用于只有两条记录的组中的一条记录，而对于组中的下一条记录，它将是 NA，因为没有下一条记录，我对此没有任何问题。

标签： r dplyr lubridate

【解决方案1】：

看起来问题是由于尝试将向量与“间隔”类组合而引起的。具体来说，它们似乎正在转换为数字并丢失其固有信息。

我认为唯一可行的解决方案是split data.frame，使用lapply 分别对每个组件运行分析，然后使用bind_rows 将它们重新组合在一起。只有一个条目的组数会出现问题，因为在删除 NA 后参数为空时，max 和 min 返回 -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))

# 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

【讨论】：

谢谢。我在 slack 上也得到了 map_db 的类似帮助，但不是那么优雅，即 intersect 计算正确，但间隔确实转换为数字。他们甚至会有警告......但他们不应该留下来吗？这个例子也将有助于学习！再次感谢。放在这里记录一下合适吗？
@JacekKotowski -- 很高兴这有效。我对如何存储周期的内部机制了解不足，无法了解导致问题的原因。它们似乎可以在group_by/mutate 之外很好地使用c()，因此它可能与用于重新矢量化的方法有关。但是，我什至不知道从哪里开始挖掘。

【解决方案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)

【讨论】：