Dplyr / Lubridate:分组后如何汇总重叠间隔

时间:2018-01-22 18:13:42

标签: r dplyr lubridate

我想将协议分组,然后比较他们的期间重叠(或分开)的程度。

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

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

)

2 个答案:

答案 0 :(得分:1)

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

我认为唯一可行的解​​决方案是split data.frame,使用lapply分别对每个组件进行分析,然后将其与bind_rows一起重新组合。在删除NA后,当参数为空时,只有一个条目的组的数量会出现maxmin返回-InfInf的问题。但是,这很容易纠正。

此代码应该有效。请注意,我使用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 

答案 1 :(得分:0)

我只是为了记录。我收到了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)