如何在R中按连续起止时间分组并计算总出行成本？

需要将连续的起始时间和结束时间记录分组，计算每日总时长对应的总出行成本。以下是示例数据、期望输出及尝试的代码，但未得到预期结果，需找出代码问题并修正。

清空工作区内存 #

rm(list = ls())

所需库 #

library(tidyverse)
library(lubridate)

创建示例数据 #

df <- data.frame(CountryID = c('101', '101', '101', '101', '101', '102', '102', '102', '102'),
                 AreaID = c('1', '1', '1', '1', '1', '2', '2', '2', '2'),
                 Period = c('01/01/2023', '01/01/2023', '01/01/2023', '01/01/2023', '01/01/2023', '02/01/2023', '02/01/2023', '02/01/2023', '02/01/2023'),
                 Day = c('Sunday', 'Sunday', 'Sunday', 'Sunday', 'Sunday', 'Monday', 'Monday', 'Monday', 'Monday'),
                 StartTime = c('7:00:00 AM', '7:30:00 AM', '8:00:00 AM', '8:30:00 AM', '9:00:00 AM', '7:00:00 AM', '7:30:00 AM', '8:00:00 AM', '8:30:00 AM'),
                 EndTime = c('7:30:00 AM', '8:00:00 AM', '8:30:00 AM', '9:00:00 AM', '9:30:00 AM', '7:30:00 AM', '8:00:00 AM', '8:30:00 AM', '9:00:00 AM'),
                 TravelCost = c('10', '12', '11', '13', '14', '12', '10', '9', '8'))

期望输出 #

Output <- data.frame(CountryID = c(101, 102),
                     AreaID = c(1, 2),
                     Period = c('01/01/2023', '02/01/2023'),
                     Day = c('Sunday', 'Monday'),
                     StartTime = c('7:00:00 AM', '7:00:00 AM'),
                     EndTime = c('9:30:00 AM', '9:00:00 AM'),
                     TotalTravelCost = c('60', '39'))

尝试的代码（未得到预期结果） #

Output <- df %>%
  group_by(CountryID, AreaID, Period, Day, StartTime, EndTime) %>%
  summarise(TotalTravelCost = sum(TravelCost))

原代码的问题 #

• 分组维度错误：原代码把StartTime和EndTime也加入分组，导致每一行单独成组，无法合并连续的时间段。
• 数据类型错误：TravelCost列是字符型，直接sum会报错，需要先转为数值型。
• 未识别连续时间段：没有判断同组（CountryID/AreaID/Period/Day）内的记录是否连续（上一条的EndTime等于下一条的StartTime），也就无法合并这些连续记录。

修正后的代码 #

Output <- df %>%
  # 转换时间列和成本列的类型，方便后续计算与比较
  mutate(
    StartTime = hms(StartTime),
    EndTime = hms(EndTime),
    TravelCost = as.numeric(TravelCost)
  ) %>%
  # 按分组键分组后，按起始时间排序，确保时间顺序正确
  group_by(CountryID, AreaID, Period, Day) %>%
  arrange(StartTime) %>%
  # 标记连续的时间段分组：当前行StartTime不等于上一行EndTime时，新建分组
  mutate(
    group_id = cumsum(if_else(row_number() == 1, TRUE, StartTime != lag(EndTime)))
  ) %>%
  # 按新的分组键汇总数据
  group_by(CountryID, AreaID, Period, Day, group_id) %>%
  summarise(
    StartTime = format(min(StartTime), "%I:%M:%S %p"), # 转回原时间格式
    EndTime = format(max(EndTime), "%I:%M:%S %p"),
    TotalTravelCost = sum(TravelCost) %>% as.character(), # 转为字符型匹配期望输出
    .groups = "drop"
  ) %>%
  # 移除临时的分组标记列
  select(-group_id)

代码说明 #

1. 类型转换：用hms将时间字符串转为时间对象，便于时间比较；将TravelCost转为数值型，确保求和运算正常。
2. 排序与分组标记：先按起始时间排序，再通过cumsum生成连续时间段的分组ID——当当前行的开始时间与上一行的结束时间不匹配时，分组ID递增，实现连续时间段的分组。
3. 汇总计算：按标记的分组ID汇总，取每组最早的起始时间、最晚的结束时间，求和总成本后转回原格式，匹配期望输出的样式。

内容的提问来源于stack exchange，提问作者Dr Nikhil Chandra Sarkar