如何用R（含lubridate）计算会话在指定时段的有效分钟数？

问题描述 #

现有样本数据集（每行对应一个会话）：

StartTime   EndTime User
5/18/2023 2:40  5/18/2023 4:44  FJNDS
5/18/2023 4:04  5/18/2023 5:07  DFDSFDS
5/18/2023 5:07  5/18/2023 5:13  CXXZVC
5/18/2023 1:40  5/18/2023 5:41  SAFDSFD
5/18/2023 1:40  5/18/2023 5:41  VCXZVXC
5/18/2023 4:31  5/19/2023 5:47  VDSFSDFD

需求：

• 判断每个会话是否覆盖3:00-6:00时段
• 若覆盖则新增一列记录该时段内的分钟数
• 跨天会话需累计两天3:00-6:00时段的总分钟数
• 询问是否可用lubridate包实现，也接受其他R函数

实现方案（使用lubridate+dplyr） #

完全可以用lubridate包实现，结合dplyr的便捷操作，以下是具体步骤：

1. 加载包并读取数据 #

library(lubridate)
library(dplyr)

# 构造样本数据框
df <- data.frame(
  StartTime = c("5/18/2023 2:40", "5/18/2023 4:04", "5/18/2023 5:07", "5/18/2023 1:40", "5/18/2023 1:40", "5/18/2023 4:31"),
  EndTime = c("5/18/2023 4:44", "5/18/2023 5:07", "5/18/2023 5:13", "5/18/2023 5:41", "5/18/2023 5:41", "5/19/2023 5:47"),
  User = c("FJNDS", "DFDSFDS", "CXXZVC", "SAFDSFD", "VCXZVXC", "VDSFSDFD")
)

2. 转换时间格式 #

将字符型的起止时间转换为lubridate支持的POSIXct格式：

df <- df %>%
  mutate(
    StartTime = mdy_hm(StartTime),
    EndTime = mdy_hm(EndTime)
  )

3. 定义覆盖时长计算函数 #

核心逻辑是分别处理单天和跨天会话，计算与目标时段（每日3:00-6:00）的交集时长：

calc_coverage <- function(start_dt, end_dt) {
  # 提取会话的起止日期
  start_date <- date(start_dt)
  end_date <- date(end_dt)
  
  # 第一天的3:00-6:00时段
  day1_3am <- ymd_hm(paste(start_date, "03:00"))
  day1_6am <- ymd_hm(paste(start_date, "06:00"))
  
  # 计算第一天的重叠分钟数
  overlap_day1 <- interval(max(start_dt, day1_3am), min(end_dt, day1_6am))
  mins_day1 <- ifelse(int_length(overlap_day1) > 0, int_length(overlap_day1)/60, 0)
  
  total_mins <- mins_day1
  
  # 处理跨天情况，计算第二天的重叠分钟数
  if (end_date > start_date) {
    day2_3am <- ymd_hm(paste(end_date, "03:00"))
    day2_6am <- ymd_hm(paste(end_date, "06:00"))
    
    overlap_day2 <- interval(max(start_dt, day2_3am), min(end_dt, day2_6am))
    mins_day2 <- ifelse(int_length(overlap_day2) > 0, int_length(overlap_day2)/60, 0)
    
    total_mins <- total_mins + mins_day2
  }
  
  # 返回是否覆盖及总分钟数
  list(has_coverage = total_mins > 0, coverage_mins = total_mins)
}

4. 应用函数生成结果列 #

用pmap_dfr批量处理每一行数据，合并到原数据框：

df <- df %>%
  bind_cols(pmap_dfr(., ~calc_coverage(..1, ..2)))

最终输出示例 #

处理后的数据框关键列如下：

其中最后一行跨天会话的计算：第一天4:31到6:00共89分钟，第二天3:00到5:47共167分钟，总计256分钟。

内容的提问来源于stack exchange，提问作者Thaatha_Paati