我想将协议分组,然后比较他们的期间重叠(或分开)的程度。
我的数据框可能如下所示:
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
)
答案 0 :(得分: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
答案 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)