按发件人分组的同一时间跨度内的消息合并行

Question

我有一个数据框，其中包含来自 whatsapp 的发件人的消息。通常，人们倾向于在whatsapp中使用不止一条消息来说些什么。我的目标是将在大约 5 分钟的时间范围内发送的消息合并为一行。这必须按发件人分组，因为数据帧包含多个发件人。我的数据框如下所示：

Message             Time                    Sender
hello               2018-12-14 16:27:00     300
how are you?        2018-12-14 16:29:00     300
do you reply?       2018-12-15 12:00:00     300
Hi                  2018-12-14 16:30:00     200
Hi                  2018-12-15 16:36:00     200

现在我希望它看起来像这样：

Message             Time                    Sender
hello how are you?  2018-12-14 16:27:00     300
do you reply?       2018-12-15 12:00:00     300
Hi                  2018-12-14 16:30:00     200
Hi                  2018-12-15 16:3600      200

第一个和第二个已合并。到目前为止，我的尝试是将 group_map 与 reduce 一起使用，但我似乎找不到解决方案。

joinedMessageTable <- messageTable %>% group_by(Sender) %>% group_map(function(table, sender) {
    Reduce(function(firstElement, result) {
        value <- (firstElement + 5 *60 > result)
    }, table$time)
})

有人知道怎么解决吗？

Answer 1

您可以使用ceiling_date 来创建每 5 分钟一次的群组 -

library(dplyr)
library(lubridate)

messageTable %>%
  group_by(Sender, Time = ceiling_date(mdy_hm(Time), unit = '5 mins')) %>%
  summarise(Message = paste0(Message, collapse = ' ')) %>%
  ungroup

如果您想考虑连续值之间的差异，可以持续 5 分钟 -

df %>%
  mutate(Time = mdy_hm(Time)) %>%
  group_by(Sender) %>%
  mutate(group = cumsum(difftime(Time, 
                   lag(Time, default = first(Time)), units = 'mins') > 5)) %>%
  group_by(group, .add = TRUE) %>%
  summarise(Message = paste0(Message, collapse = ' ')) %>%
  ungroup

Answer 2

这行得通吗：

library(stringr)
library(dplyr)
df %>% group_by(Sender) %>% 
   mutate(flag = +(difftime(lead(Time), Time, units = 'min') < 5), flag = replace_na(flag, 0),
          Message = case_when(flag == 1 ~ str_c(Message, lead(Message), sep = ' '), TRUE ~ Message),
          Time = case_when(lag(flag) == 1 & flag == 0 ~ lag(Time), TRUE ~ Time)) %>% select(-flag) %>% filter(!duplicated(Time))
# A tibble: 4 x 3
# Groups:   Sender [2]
  Message            Time                Sender
  <chr>              <dttm>               <dbl>
1 hello how are you? 2018-12-14 16:27:00    300
2 do you reply?      2018-12-15 12:00:00    300
3 Hi                 2018-12-14 16:30:00    200
4 Hi                 2018-12-15 16:36:00    200

Answer 3

如果输出对您有帮助，您也可以runner（用于计算滑动窗口/滚动计算的库），

my_df <- read.table(text = "Message             Time                    Sender
'hello'               '2018-12-14 16:27:00'     300
'how are you?'        '2018-12-14 16:29:00'     300
'do you reply?'       '2018-12-15 12:00:00'     300
'Hi'                  '2018-12-14 16:30:00'     200
'Hi'                  '2018-12-15 16:36:00'     200", header = T)

my_df$Time <- as.POSIXct(my_df$Time)

library(tidyverse)
library(runner)

my_df %>% group_by(Sender) %>%
  mutate(msg = runner(Message,
                      idx = Time,
                      k = '5 mins',
                      f = toString))
#> # A tibble: 5 x 4
#> # Groups:   Sender [2]
#>   Message       Time                Sender msg                
#>   <chr>         <dttm>               <int> <chr>              
#> 1 hello         2018-12-14 16:27:00    300 hello              
#> 2 how are you?  2018-12-14 16:29:00    300 hello, how are you?
#> 3 do you reply? 2018-12-15 12:00:00    300 do you reply?      
#> 4 Hi            2018-12-14 16:30:00    200 Hi                 
#> 5 Hi            2018-12-15 16:36:00    200 Hi

^{由reprex package (v2.0.0) 于 2021 年 5 月 30 日创建}

Answer 4

我们可以使用

library(dplyr)
library(lubridate)

messageTable %>%
  group_by(Sender, Time = ceiling_date(mdy_hm(Time), unit = '5 mins')) %>%
  summarise(Message = toString(Message), .groups = 'drop') 

Answer 5

在结束检查后，@Ronak 给出的解决方案并没有完全奏效。我使用其中的一些代码来制作自己的实现。 Ronak 的代码存在的问题是它使用 false 和 true 进行分组，因此只能制作两组时间。事实上，我需要根据具有累积窗口的时间来拥有多个具有多个发件人的组。

我提出的解决方案并未真正证实 R 哲学，因此请随意改进。

my_df <- read.table(text = "Message             Time                    Sender
                       'hello'               '2018-12-14 16:27:00'     300
                       'how are you?'        '2018-12-14 16:34:00'     300
                       'are you good?'       '2018-12-14 16:29:00'     300
                       'do you reply?'       '2018-12-15 12:00:00'     300
                       'Have you received?'  '2018-12-15 16:34:00'     300
                       'are you good?'       '2018-12-15 16:29:00'     300
                       'Hi'                  '2018-12-14 16:30:00'     200
                       'Hi'                  '2018-12-15 16:36:00'     200
                       'Who is this?'        '2018-12-15 16:35:00'     100
                       'Hi'                  '2018-12-15 16:35:00'     100", header = T)

my_df$Time <- as.POSIXct(my_df$Time)

merged_df <- my_df %>% 
  group_by(Sender, Time) %>% 
  mutate(Message = paste0(Message, collapse = " ")) %>%
  distinct(Message, Sender, Time, .keep_all = TRUE) %>%
  group_by(Sender) %>%
  arrange(Time) %>%
  group_modify(function(table, sender) {
    counter <<- 1
    begin <<- first(table$Time)
    for (i in seq_len(nrow(table))) {
      if (isTRUE(abs(difftime(begin, table[i,]$Time, units = "mins")) > 5)) {
        counter <<- counter + 1
      }
      begin <<- table[i,]$Time
      table[i, "counter"] <- counter
    }
    table
  }) %>%
  group_by(Sender, counter, add = TRUE) %>%
  mutate(
    Message = paste0(Message, collapse = ' ')
  ) %>%
  distinct(Sender, counter, .keep_all = TRUE) %>%
  select(-counter)

编辑
正如 Ronak 指出的那样，上述问题并不是真正的问题。使用安排它可以解决问题。完整的解决方案是：

df <- joinedFrame %>%
  group_by(Sender) %>%
  arrange(time) %>%
  mutate(group = cumsum(difftime(time,
                               lag(time, default = first(time)), units = 'mins') > 5)) %>%
  group_by(group, .add = TRUE) %>%
  mutate(English = paste0(English, collapse = ' ')) %>%
  ungroup %>% distinct(Sender, group, .keep_all = TRUE)

我保留我的解决方案和上面的对话以供参考