Dplyr / Lubridate：分组后如何汇总重叠间隔-Java 学习之路

我想将协议分组，然后比较它们的周期重叠（或分开）的程度 .

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

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，代码）％>％，则会正确创建间隔，并且还会从下一行正确计算前导间隔 . 但是当我天真地使用group_by时，间隔不能正确计算 .

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

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

编辑：所需的输出应该是一个列，其间隔天的重叠值（如果没有重叠，则为间隔之间的距离） . 分组会破坏计算 . 我希望在组内计算这些值（不是在它们之间） .

编辑2：我试图通过将数据帧拆分为数据帧列表然后组合它来解决问题，但我不确定语法 . 它不是很有效，产生一列的表，我在其他门户网站给出的帮助（也许它可以解决问题） . 我们的想法是拆分数据库，创建新列并将表组合到一个表中 .

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 回答

看起来这个问题是由于尝试将向量与“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

回复于 2024-05-03T14:49:05+08:00

0
我只是为了记录 . 我收到了Jake Knaupp对slack r4ds组的回答，其中包含现代的map_df（）语法，它计算了句点的重叠但是 it converts periods to numeric. And there is a bunch of warnings it will do that.
```
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)
```
回复于 2024-05-03T14:49:05+08:00

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

2 回答

相关问题