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
)

我想改变一个列来创建rubridate期间，并在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，代码）％＆gt;％，则会正确创建间隔，并且还会从下一行正确计算前导间隔。但是当我天真地使用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

)

Answer 1

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

我认为唯一可行的解决方案是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

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：分组后如何汇总重叠间隔

2 个答案: