我正在开发一个基于tidyverse
的数据工作流,并且遇到一种情况,即我的数据帧具有很多时间间隔。让我们将数据帧称为my_time_intervals
,它可以像这样复制:
library(tidyverse)
library(lubridate)
my_time_intervals <- tribble(
~id, ~group, ~start_time, ~end_time,
1L, 1L, ymd_hms("2018-04-12 11:15:03"), ymd_hms("2018-05-14 02:32:10"),
2L, 1L, ymd_hms("2018-07-04 02:53:20"), ymd_hms("2018-07-14 18:09:01"),
3L, 1L, ymd_hms("2018-05-07 13:02:04"), ymd_hms("2018-05-23 08:13:06"),
4L, 2L, ymd_hms("2018-02-28 17:43:29"), ymd_hms("2018-04-20 03:48:40"),
5L, 2L, ymd_hms("2018-04-20 01:19:52"), ymd_hms("2018-08-12 12:56:37"),
6L, 2L, ymd_hms("2018-04-18 20:47:22"), ymd_hms("2018-04-19 16:07:29"),
7L, 2L, ymd_hms("2018-10-02 14:08:03"), ymd_hms("2018-11-08 00:01:23"),
8L, 3L, ymd_hms("2018-03-11 22:30:51"), ymd_hms("2018-10-20 21:01:42")
)
以下是同一数据框的tibble
视图:
> my_time_intervals
# A tibble: 8 x 4
id group start_time end_time
<int> <int> <dttm> <dttm>
1 1 1 2018-04-12 11:15:03 2018-05-14 02:32:10
2 2 1 2018-07-04 02:53:20 2018-07-14 18:09:01
3 3 1 2018-05-07 13:02:04 2018-05-23 08:13:06
4 4 2 2018-02-28 17:43:29 2018-04-20 03:48:40
5 5 2 2018-04-20 01:19:52 2018-08-12 12:56:37
6 6 2 2018-04-18 20:47:22 2018-04-19 16:07:29
7 7 2 2018-10-02 14:08:03 2018-11-08 00:01:23
8 8 3 2018-03-11 22:30:51 2018-10-20 21:01:42
关于my_time_intervals
的一些说明:
通过group
变量将数据分为三组。
id
变量只是数据框中每一行的唯一ID。
时间间隔的开始和结束以start_time
的形式存储在end_time
和lubridate
中。
有些时间间隔重叠,有些则不重叠,并且它们总是 not 依次排列。例如,行1
与行3
重叠,但是它们都不与行2
重叠。
两个以上的间隔可能会相互重叠,并且某些间隔完全落入其他间隔内。请参阅4
中的6
到group == 2
行。
我想要的是在每个group
中,将任何重叠的时间间隔折叠为连续的间隔。在这种情况下,我想要的结果将如下所示:
# A tibble: 5 x 4
id group start_time end_time
<int> <int> <dttm> <dttm>
1 1 1 2018-04-12 11:15:03 2018-05-23 08:13:06
2 2 1 2018-07-04 02:53:20 2018-07-14 18:09:01
3 4 2 2018-02-28 17:43:29 2018-08-12 12:56:37
4 7 2 2018-10-02 14:08:03 2018-11-08 00:01:23
5 8 3 2018-03-11 22:30:51 2018-10-20 21:01:42
请注意, 个不同的group
之间重叠的时间间隔不。另外,我现在不在乎id
列会发生什么。
我知道lubridate
软件包包括与间隔有关的功能,但是我不知道如何将它们应用于此用例。
我该如何实现?非常感谢。
答案 0 :(得分:3)
select id,
rtrim(extract(xmlagg(xmlelement(e, to_clob(col1) || '; ' || col2 || '; ' || col3 || '; ')),
'/E/text()').getclobval(), chr(13)) AS concat_field from schema.table group by id
我正在制作另一个数据集,该数据集在每个组中有更多的重叠时间,因此该解决方案将获得更多的了解,并希望可以更好地加以掌握;
my_time_intervals %>% group_by(group) %>% arrange(start_time) %>%
mutate(indx = c(0, cumsum(as.numeric(lead(start_time)) >
cummax(as.numeric(end_time)))[-n()])) %>%
group_by(group, indx) %>%
summarise(start_time = min(start_time), end_time = max(end_time)) %>%
select(-indx)
# # A tibble: 5 x 3
# # Groups: group [3]
# group start_time end_time
# <int> <dttm> <dttm>
# 1 1 2018-04-12 11:15:03 2018-05-23 08:13:06
# 2 1 2018-07-04 02:53:20 2018-07-14 18:09:01
# 3 2 2018-02-28 17:43:29 2018-08-12 12:56:37
# 4 2 2018-10-02 14:08:03 2018-11-08 00:01:23
# 5 3 2018-03-11 22:30:51 2018-10-20 21:01:42
因此,让我们看一下该数据集的my_time_intervals <- tribble(
~id, ~group, ~start_time, ~end_time,
1L, 1L, ymd_hms("2018-04-12 11:15:03"), ymd_hms("2018-05-14 02:32:10"),
2L, 1L, ymd_hms("2018-07-04 02:53:20"), ymd_hms("2018-07-14 18:09:01"),
3L, 1L, ymd_hms("2018-07-05 02:53:20"), ymd_hms("2018-07-14 18:09:01"),
4L, 1L, ymd_hms("2018-07-15 02:53:20"), ymd_hms("2018-07-16 18:09:01"),
5L, 1L, ymd_hms("2018-07-15 01:53:20"), ymd_hms("2018-07-19 18:09:01"),
6L, 1L, ymd_hms("2018-07-20 02:53:20"), ymd_hms("2018-07-22 18:09:01"),
7L, 1L, ymd_hms("2018-05-07 13:02:04"), ymd_hms("2018-05-23 08:13:06"),
8L, 1L, ymd_hms("2018-05-10 13:02:04"), ymd_hms("2018-05-23 08:13:06"),
9L, 2L, ymd_hms("2018-02-28 17:43:29"), ymd_hms("2018-04-20 03:48:40"),
10L, 2L, ymd_hms("2018-04-20 01:19:52"), ymd_hms("2018-08-12 12:56:37"),
11L, 2L, ymd_hms("2018-04-18 20:47:22"), ymd_hms("2018-04-19 16:07:29"),
12L, 2L, ymd_hms("2018-10-02 14:08:03"), ymd_hms("2018-11-08 00:01:23"),
13L, 3L, ymd_hms("2018-03-11 22:30:51"), ymd_hms("2018-10-20 21:01:42")
)
列。我正在按indx
列添加arrange
,以查看所有相同的分组行;但是,正如您所知,因为我们有group
,所以我们实际上并不需要它。
group_by(group)
如您所见,在一组中,我们有3个不同的时间段,其中数据点重叠,而一个数据点在该组中没有重叠的条目。 my_time_intervals %>% group_by(group) %>% arrange(group,start_time) %>%
mutate(indx = c(0, cumsum(as.numeric(lead(start_time)) >
cummax(as.numeric(end_time)))[-n()]))
# # A tibble: 13 x 5
# # Groups: group [3]
# id group start_time end_time indx
# <int> <int> <dttm> <dttm> <dbl>
# 1 1 1 2018-04-12 11:15:03 2018-05-14 02:32:10 0
# 2 7 1 2018-05-07 13:02:04 2018-05-23 08:13:06 0
# 3 8 1 2018-05-10 13:02:04 2018-05-23 08:13:06 0
# 4 2 1 2018-07-04 02:53:20 2018-07-14 18:09:01 1
# 5 3 1 2018-07-05 02:53:20 2018-07-14 18:09:01 1
# 6 5 1 2018-07-15 01:53:20 2018-07-19 18:09:01 2
# 7 4 1 2018-07-15 02:53:20 2018-07-16 18:09:01 2
# 8 6 1 2018-07-20 02:53:20 2018-07-22 18:09:01 3
# 9 9 2 2018-02-28 17:43:29 2018-04-20 03:48:40 0
# 10 11 2 2018-04-18 20:47:22 2018-04-19 16:07:29 0
# 11 10 2 2018-04-20 01:19:52 2018-08-12 12:56:37 0
# 12 12 2 2018-10-02 14:08:03 2018-11-08 00:01:23 1
# 13 13 3 2018-03-11 22:30:51 2018-10-20 21:01:42 0
列将这些数据点分为4组(即indx
)。在解决方案的稍后部分,当我们0, 1, 2, 3
在一起时,我们将所有这些重叠的部分放在一起,并获得了开始的最初时间和最后的结束时间,以产生所需的输出。
只是使解决方案更容易出错(以防我们有一个数据点比一组(组和索引)中的其他所有数据点更早开始但结束得比其他所有数据点更早,例如ID为6和7)我将group_by(indx,group)
和first()
更改为last()
和min()
。
所以...
max()
我们使用每个重叠时间和日期的唯一索引来获取每个时间和日期的时间段(开始和结束)。
除了这一点,您还需要阅读my_time_intervals %>% group_by(group) %>% arrange(group,start_time) %>%
mutate(indx = c(0, cumsum(as.numeric(lead(start_time)) >
cummax(as.numeric(end_time)))[-n()])) %>%
group_by(group, indx) %>%
summarise(start_time = min(start_time), end_time = max(end_time))
# # A tibble: 7 x 4
# # Groups: group [?]
# group indx start_time end_time
# <int> <dbl> <dttm> <dttm>
# 1 1 0 2018-04-12 11:15:03 2018-05-23 08:13:06
# 2 1 1 2018-07-04 02:53:20 2018-07-14 18:09:01
# 3 1 2 2018-07-15 01:53:20 2018-07-19 18:09:01
# 4 1 3 2018-07-20 02:53:20 2018-07-22 18:09:01
# 5 2 0 2018-02-28 17:43:29 2018-08-12 12:56:37
# 6 2 1 2018-10-02 14:08:03 2018-11-08 00:01:23
# 7 3 0 2018-03-11 22:30:51 2018-10-20 21:01:42
和cumsum
,并查看此特定问题的这两个函数的输出,以了解为什么我进行的比较最终给了我们每个重叠时间和日期的唯一标识符。
希望这会有所帮助,因为这是我最好的。
答案 1 :(得分:2)
另一种tidyverse
方法:
library(tidyverse)
library(lubridate)
my_time_intervals %>%
arrange(group, start_time) %>%
group_by(group) %>%
mutate(new_end_time = if_else(end_time >= lead(start_time), lead(end_time), end_time),
g = new_end_time != end_time | is.na(new_end_time),
end_time = if_else(end_time != new_end_time & !is.na(new_end_time), new_end_time, end_time)) %>%
filter(g) %>%
select(-new_end_time, -g)
答案 2 :(得分:1)
我们可以按start_time
进行排序,然后嵌套并在子表中使用reduce合并相关的行(使用Masoud的数据):
library(tidyverse)
df %>%
arrange(start_time) %>% #
select(-id) %>%
nest(start_time, end_time,.key="startend") %>%
mutate(startend = map(startend,~reduce(
seq(nrow(.))[-1],
~ if(..3[.y,1] <= .x[nrow(.x),2])
if(..3[.y,2] > .x[nrow(.x),2]) `[<-`(.x, nrow(.x), 2, value = ..3[.y,2])
else .x
else bind_rows(.x,..3[.y,]),
.init = .[1,],
.))) %>%
arrange(group) %>%
unnest()
# # A tibble: 7 x 3
# group start_time end_time
# <int> <dttm> <dttm>
# 1 1 2018-04-12 13:15:03 2018-05-23 10:13:06
# 2 1 2018-07-04 04:53:20 2018-07-14 20:09:01
# 3 1 2018-07-15 03:53:20 2018-07-19 20:09:01
# 4 1 2018-07-20 04:53:20 2018-07-22 20:09:01
# 5 2 2018-02-28 18:43:29 2018-08-12 14:56:37
# 6 2 2018-10-02 16:08:03 2018-11-08 01:01:23
# 7 3 2018-03-11 23:30:51 2018-10-20 23:01:42